From 328d184251698ea3cc1b98f58b679bee7c5ae604 Mon Sep 17 00:00:00 2001 From: checcomi Date: Fri, 16 Nov 2018 21:59:43 +0000 Subject: [PATCH] first commit --- .Rbuildignore | 2 + .gitignore | 4 + DESCRIPTION | 12 + NAMESPACE | 2 + R/PRELES.R | 150 ++++++ R/clcut.r | 53 ++ R/extractVars.r | 31 ++ R/mai.r | 21 + R/multiSitePrebas.r | 317 ++++++++++++ R/plot.prebas.r | 104 ++++ R/prebas.r | 170 +++++++ R/utilStaff.r | 26 + R/yasso_routines.r | 497 ++++++++++++++++++ Rprebasso.Rproj | 13 + data/ClCut.rdata | Bin 0 -> 308 bytes data/parameters.RData | Bin 0 -> 1759 bytes data/postparamset.rda | Bin 0 -> 59817 bytes data/s1.rdata | Bin 0 -> 34064 bytes man/PRELES.Rd | 140 ++++++ man/Rpreles-package.Rd | 89 ++++ man/plot.prebas.Rd | 195 +++++++ man/prebas.Rd | 292 +++++++++++ src/A_routines.f90 | 782 +++++++++++++++++++++++++++++ src/B_prebas_v0.f90 | 1089 ++++++++++++++++++++++++++++++++++++++++ src/B_prebas_v1.f90 | 1025 +++++++++++++++++++++++++++++++++++++ src/C_multiPrebas.f90 | 68 +++ src/C_regionPrebas.f90 | 252 ++++++++++ src/call_preles.c | 208 ++++++++ src/gpp.c | 159 ++++++ src/initruns.c | 14 + src/preles.c | 258 ++++++++++ src/prelesglobals.h | 89 ++++ src/water.c | 252 ++++++++++ tests/testrun.R | 46 ++ 34 files changed, 6360 insertions(+) create mode 100644 .Rbuildignore create mode 100644 .gitignore create mode 100644 DESCRIPTION create mode 100644 NAMESPACE create mode 100644 R/PRELES.R create mode 100644 R/clcut.r create mode 100644 R/extractVars.r create mode 100644 R/mai.r create mode 100644 R/multiSitePrebas.r create mode 100644 R/plot.prebas.r create mode 100644 R/prebas.r create mode 100644 R/utilStaff.r create mode 100644 R/yasso_routines.r create mode 100644 Rprebasso.Rproj create mode 100644 data/ClCut.rdata create mode 100644 data/parameters.RData create mode 100644 data/postparamset.rda create mode 100644 data/s1.rdata create mode 100644 man/PRELES.Rd create mode 100644 man/Rpreles-package.Rd create mode 100644 man/plot.prebas.Rd create mode 100644 man/prebas.Rd create mode 100644 src/A_routines.f90 create mode 100644 src/B_prebas_v0.f90 create mode 100644 src/B_prebas_v1.f90 create mode 100644 src/C_multiPrebas.f90 create mode 100644 src/C_regionPrebas.f90 create mode 100644 src/call_preles.c create mode 100644 src/gpp.c create mode 100644 src/initruns.c create mode 100644 src/preles.c create mode 100644 src/prelesglobals.h create mode 100644 src/water.c create mode 100644 tests/testrun.R diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..91114bf --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6a065 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..7f75a2b --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,12 @@ +Package: Rprebasso +Type: Package +Title: PRELES, YASSO and PREBAS models +Version: 0.1.0 +Author: Mikko Peltoniemi and Francesco Minunno +Maintainer: Francesco Minunno and Mikko Peltoniemi +Description: Implements PRELES,YASSO and PREBAS models to be called from R +Depends: sm, data.table, Matrix, zoo +License: What license is it under? +Encoding: UTF-8 +LazyData: true +RoxygenNote: 6.1.0 diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..8aa4f9f --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,2 @@ +useDynLib(Rprebasso) +exportPattern("^[[:alpha:]]+") diff --git a/R/PRELES.R b/R/PRELES.R new file mode 100644 index 0000000..e1ec059 --- /dev/null +++ b/R/PRELES.R @@ -0,0 +1,150 @@ +PRELES = function(PAR, TAir, VPD, Precip, CO2, fAPAR, ## REQUIRED + GPPmeas=NA, ETmeas=NA, SWmeas=NA, ## OPTIONAL FOR BYPASSING PREDICTION + p = rep(NA, 30), ## PARAMETER VECTOR. NA parameters replaced with defaults. + DOY=NA, ## Needed for deciduous phenology (and if radmodel != 0), otherwise assume simulation + ## starting DOY=1, and continuing all years having 365 days + ## Irrelevant if fPheno-parameters are -999 (default, used for conifers) + LOGFLAG = 0, control=0, pft="evergreen",# Control is the E model selection parameter. + 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 + returncols=c('GPP','ET','SW')) { + + + len = as.integer(length(TAir)) + if (is.na(GPPmeas)) GPPmeas = rep(-999, len) + if (is.na(ETmeas)) ETmeas = rep(-999, len) + if (is.na(SWmeas)) SWmeas = rep(-999, len) + transp = evap = fWE = rep(-999, len) + + ## NOT SUPPORTED PRESENTLY: + ## If radiation information is missing, daily radiation can be calculated + ## from theoretical model based on latitude (deg), modified by empirical relationship + ## if (parmodel == 1 | parmodel == 2) { ## Theoretical radiation modified by VPD + ## stopifnot(!any(is.na(LAT))) + ## PAR=dPAR(LAT=LAT,DOY=DOY,VPD=VPD, radmodel=parmodel) + ## } + ## if (parmodel == 11 | parmodel == 12) { ## Speed-up, requires calculation of dPAR0() + ## PAR=dPAR1(PAR0,VPD=VPD, radmodel=parmodel) + ##} + + + ## PARAMETERS + if (control == -1) {} ## FOR TESTS + ## DEFAULT SET + ## The following is default set, calibrated for a range of conifer sites in Scandinavia + ## Ten sites with varying site-years used in the calibration. + ## Variant of the calibration made to the same data by F. Minunno, + ## where evapotranspiration was not affected by temperature. + ## Here free evap. essentially follows the form proposed by Priestley-taylor eq. + if (control == 0) { + defaults = c(413.0, ## 1 soildepth + 0.450, ## 2 ThetaFC + 0.118, ## 3 ThetaPWP + 3, ## 4 tauDrainage + ## GPP_MODEL_PARAMETERS + 0.7457, ## 5 betaGPP + 10.93, ## 6 tauGPP + -3.063, ## 7 S0GPP + 17.72, ## 8 SmaxGPP + -0.1027, ## 9 kappaGPP + 0.03673, ## 10 gammaGPP + 0.7779, ## 11 soilthresGPP + 0.500, ## 12 b.CO2, cmCO2 + -0.364, ## 13 x.CO2, ckappaCO2 + ## EVAPOTRANSPIRATION_PARAMETERS + 0.2715, ## 14 betaET + 0.8351, ## 15 kappaET + 0.07348, ## 16 chiET + 0.9996, ## 17 soilthresET + 0.4428, ## 18 nu ET + ## SNOW_RAIN_PARAMETERS + 1.2, ## 19 Meltcoef + 0.33, ## 20 I_0 + 4.970496, ## 21 CWmax, i.e. max canopy water + 0, ## 22 SnowThreshold, + 0, ## 23 T_0, + 160, ## 24 SWinit, ## START INITIALISATION PARAMETERS + 0, ## 25 CWinit, ## Canopy water + 0, ## 26 SOGinit, ## Snow on Ground + 20, ## 27 Sinit ##CWmax + -999, ## t0 fPheno_start_date_Tsum_accumulation; conif -999, for birch 57 + -999, ## tcrit, fPheno_start_date_Tsum_Tthreshold, 1.5 birch + -999 ##tsumcrit, fPheno_budburst_Tsum, 134 birch + ) + } + + if (control == 1) ## Peltoniemi et al., 2015, Boreal Env. Res. for Hyytiala + defaults = c(413.0, + 0.450, 0.118, 3, 0.748464, 12.74915, -3.566967, 18.4513, -0.136732, + 0.033942, 0.448975, 0.500, -0.364, 0.33271, 0.857291, 0.041781, + 0.474173, 0.278332, 1.5, 0.33, 4.824704, 0, 0, 180, 0, 0, 10, + -999, -999, -999) + p[is.na(p)] = defaults[is.na(p)] ## Note: this may slow down a bit when looping MCMC + + ## DOY is needed for other than conifers. Phenology model requires parameters: + ## tip: p[28:30] <- c(57, 1.5, 134) # Phenol. mod. (Linkosalo et al. 2008) + if (pft != "evergreen") { + stopifnot(all(!is.na(DOY))) + stopifnot(all(!is.na(p[28:30]))) + } + ## There is no phenology of shoot growth for conifers presently + if (pft == "evergreen") { + if (any(is.na(p[28:30]))) warning('Phenology parameters given, but not implemented in the model for conifers.') + p[28] = -999 + } + ## If DOY is missing we need to give to the model, although conifer shoot growth phenology is not implemented. + if (pft == "evergreen" & any(is.na(DOY))) { + DOY = rep(1:365, ceiling(len/365)) + DOY = DOY[1:len] + } + + .C('call_preles', + PAR=as.double(PAR), TAir=as.double(TAir), VPD=as.double(VPD), + Precip=as.double(Precip), CO2=as.double(CO2), fAPAR=as.double(fAPAR), + GPPmeas=as.double(GPPmeas), ETmeas=as.double(ETmeas), SWmeas=as.double(SWmeas), + ## OUTPUTS + GPP = double(len), ET=double(len), SW=double(len), SOG=double(len), + fS=double(len), fD=double(len), fW=double(len), fE=double(len), + Throughfall=double(len), Interception=double(len), Snowmelt=double(len), + Drainage =double(len), + Canopywater=double(len), S=double(len), + + ##PARAMETERS + p1=as.double(p[1]), + p2=as.double(p[2]), + p3=as.double(p[3]), + p4=as.double(p[4]), + p5=as.double(p[5]), ## START GPP PARAMETERS + p6=as.double(p[6]), + p7=as.double(p[7]), + p8=as.double(p[8]), + p9=as.double(p[9]), + p10=as.double(p[10]), + p11=as.double(p[11]), ## used for fW with ETmodel = 2 | 4 | 6 + p12=as.double(p[12]), ## used for fW with ETmodel = 1 | 3 | 5 + p13=as.double(p[13]), ## used for fW with ETmodel = 1 | 3 | 5) ; + p14=as.double(p[14]), ## START ET PARAMETERS + p15=as.double(p[15]), + p16=as.double(p[16]), + p17=as.double(p[17]), ## used for fW with ETmodel = 2 | 4 + p18=as.double(p[18]), ## used for fW with ETmodel = 1 | 3 + p19=as.double(p[19]), ## START WATER/SNOW PARAMETERS + p20=as.double(p[20]), + p21=as.double(p[21]), + p22=as.double(p[22]), + p23=as.double(p[23]), + p24=as.double(p[24]), ## START INITIALISATION PARAMETERS // Soilw water at beginning + p25=as.double(p[25]), ## Canopy water + p26=as.double(p[26]), ## Snow on Ground + p27=as.double(p[27]), ## State of temperature acclimation + p28=as.double(p[28]), ## Canopy water + p29=as.double(p[29]), ## Snow on Ground + p30=as.double(p[30]), ## State of temperature acclimation + etmodel=as.integer(control), ## useMeasurement, int *LOGFLAG, int *multisiteNday, int *NofDays + LOGFLAG=as.integer(LOGFLAG), + len=as.integer(len), + DOY=as.integer(DOY), + transp=as.double(transp), evap=as.double(evap), + fWE=as.double(fWE))[returncols] + + +} diff --git a/R/clcut.r b/R/clcut.r new file mode 100644 index 0000000..981c4fc --- /dev/null +++ b/R/clcut.r @@ -0,0 +1,53 @@ +ClCutD_Pine <- function(ETSmean,ETSthres,siteType){ + if(siteType<=3 & ETSmean>=ETSthres) inDclct <- ClCut_pine[1,1] + if(siteType==4 & ETSmean>=ETSthres) inDclct <- ClCut_pine[2,1] + if(siteType>=5 & ETSmean>=ETSthres) inDclct <- ClCut_pine[3,1] + if(siteType<=3 & ETSmean=5 & ETSmean=ETSthres) inDclct <- ClCut_spruce[1,1] + if(siteType>=3 & ETSmean>=ETSthres) inDclct <- ClCut_spruce[2,1] + if(siteType<=2 & ETSmean=3 & ETSmean=ETSthres) inDclct <- ClCut_birch[1,1] + if(siteType>=3 & ETSmean>=ETSthres) inDclct <- ClCut_birch[2,1] + if(siteType<=2 & ETSmean=3 & ETSmean=ETSthres) inAclct <- ClCut_pine[1,2] + if(siteType==4 & ETSmean>=ETSthres) inAclct <- ClCut_pine[2,2] + if(siteType>=5 & ETSmean>=ETSthres) inAclct <- ClCut_pine[3,2] + if(siteType<=3 & ETSmean=5 & ETSmean=ETSthres) inAclct <- ClCut_spruce[1,2] + if(siteType>=3 & ETSmean>=ETSthres) inAclct <- ClCut_spruce[2,2] + if(siteType<=2 & ETSmean=3 & ETSmean=ETSthres) inAclct <- ClCut_birch[1,2] + if(siteType>=3 & ETSmean>=ETSthres) inAclct <- ClCut_birch[2,2] + if(siteType<=2 & ETSmean=3 & ETSmean1){ + prebas$totHarv <- apply(prebas$multiOut[,,37,,1],2,sum) + }else{ + prebas$totHarv <- prebas$multiOut[,,37,,1] + } +return(prebas) +} + + + diff --git a/R/plot.prebas.r b/R/plot.prebas.r new file mode 100644 index 0000000..1e3b406 --- /dev/null +++ b/R/plot.prebas.r @@ -0,0 +1,104 @@ +plot.prebas <- function(x,variableIDs=NA,siteIDs=NA,layerIDs=NA,leg=T, + layerNam = NA,obsData=NA){ + + varNam <- getVarNam() + if(all(is.na(obsData))) obsData <- matrix(NA,2,10) + if (any(variableIDs == "all") | anyNA(variableIDs)) variableIDs <-c(5,6,8:18,22,24:34,37:46) + + if(inherits(x,"prebas")){ + if(anyNA(layerIDs)) layerIDs <- 1:dim(x$output)[3] + nLayers <- length(layerIDs) + if (anyNA(layerNam)) layerNam <- as.character(paste("layer",1:nLayers)) + + count <- 0 + if (length(variableIDs) > 1) par(mfrow=c(2,3)) else par(mfrow=c(1,1)) + for(vars in variableIDs){ + count <- count + 1 + plot(x$output[,vars,layerIDs[1],1],type='l',xaxt='n', + main=varNam[vars],ylab = "units",xlab="age (y)",col=layerIDs[1], + ylim=c(min(x$output[,vars,,1]),max(x$output[,vars,,1]))) + selObs <- which(obsData[,4]==vars & obsData[,2]==layerIDs[1]) + if(length(selObs)>0) points(obsData[selObs,3],obsData[(selObs),5],col=layerIDs[1]) + + if (nLayers>1) for(ij in layerIDs[2:nLayers]){ + lines(x$output[,vars,ij,1],col=ij) + selObs <- which(obsData[,4]==vars & obsData[,2]==ij) + if(length(selObs)>0) points(obsData[selObs,3],obsData[(selObs),5],col=ij) + }# points(data) + axis(1, at=seq(1,(dim(x$output)[1]),length.out=6), labels=x$output[seq(1,(dim(x$output)[1]),length.out=6),7,1,1]) + if (leg==TRUE) legend("topleft",c(layerNam[layerIDs]),lty=1, col=layerIDs) + if (count %% 6 == 0 & vars!=tail(variableIDs,n=1)) pause() + } + } + + + if(inherits(x,"multiPrebas")){ + if(anyNA(layerIDs)) layerIDs <- 1:dim(x$multiOut)[4] + nLayers <- length(layerIDs) + if (anyNA(siteIDs)) siteIDs <- 1:dim(x$multiOut)[1] + + for(iz in siteIDs){ + if (anyNA(layerNam[iz])) layerNam <- as.character(paste("layer",1:x$nLayers[iz])) + count <- 0 + if (length(variableIDs) > 1) par(mfrow=c(2,3)) else par(mfrow=c(1,1)) + for(vars in variableIDs){ + + plot(x$multiOut[iz,,vars,layerIDs[1],1],type='l',xaxt='n', + main=varNam[vars],ylab = "units",xlab="age (y)",col=layerIDs[1], + ylim=c(min(x$multiOut[iz,,vars,,1]),max(x$multiOut[iz,,vars,,1]))) + if (nLayers>1) for(ij in layerIDs[2:nLayers]) lines(x$multiOut[iz,,vars,ij,1],col=ij) + axis(1, at=seq(1,(dim(x$multiOut)[2]),length.out=6), labels=x$multiOut[iz,seq(1,(dim(x$multiOut)[2]),length.out=6),7,1,1]) + if (leg==TRUE) legend("topleft",c(layerNam[layerIDs]),lty=1,col=layerIDs) + if(count%%6==0) title(paste('Site:', x$multiOut[iz,1,1,1,1]), line = -18, outer = TRUE,cex.main=2) + count <- count + 1 + if (count %% 6 == 0 & vars!=tail(variableIDs,n=1)) pause() + } + if (length(siteIDs)>1 & iz != tail(siteIDs,n=1)) pause()} + } +} + + + +# title_plot <- "NRMSE for the PGE Pine dataset" +# PSPpine_nrmse <- ggplot(data=pspPine_nrmse, aes(x=variableIDs, y=NRMSE, fill=calibration)) + +# geom_bar(stat="identity", color="black", position=position_dodge())+ +# ggtitle(title_plot) + scale_fill_manual(values=gray.colors(2)) + theme_classic() + +# # ylim(0,10) + +# theme(plot.title = element_text(hjust = 0.5),axis.title.x=element_blank(), +# axis.text.x=element_text(size=rel(1.7)),axis.title.y=element_text(size=15), +# axis.text.y=element_text(size=rel(1.5))) +# +# +# dd<-data.frame(matrix(c(x$output[,7,1,1],x$output[,vars,1,1]), +# length(x$output[,vars,1,1]),2)) +# +# pg <- ggplot(data = dd, aes(x=X1, y=X2)) + geom_point() +# # geom_point(data = ddx, aes(x=observed, y=simulated), color = 1,shape=19) + +# # annotate("text", x=min(c(dd$observed,dd$simulated)), y= max(c(dd$observed,dd$simulated)), label = legendSP, hjust=0) + +# # ggtitle(paste("PGEcal:",varNam[vars])) + +# # geom_abline(slope=1, intercept=0) + +# # scale_x_continuous(limits = c(min(c(dd$observed,dd$simulated)), max(c(simulated,observed)))) + +# # scale_y_continuous(limits = c(min(c(dd$observed,dd$simulated)), max(c(simulated,observed)))) + +# # theme(plot.title = element_text(hjust = 0.5)) +# +# +# grid.newpage() +# pushViewport(viewport(layout = grid.layout(6, 6, heights = unit(c(0.8, 8,0.8,8), "null")))) +# grid.text("NFI calibration", gp=gpar(cex=1.3), +# vp = viewport(layout.pos.row = 1, layout.pos.col = 1:3)) +# print(pg, vp = viewport(layout.pos.row = 2, layout.pos.col = 1)) +# print(pg, vp = viewport(layout.pos.row = 2, layout.pos.col = 2)) +# print(pg, vp = viewport(layout.pos.row = 2, layout.pos.col = 3)) +# print(pg, vp = viewport(layout.pos.row = 2, layout.pos.col = 4)) +# print(pg, vp = viewport(layout.pos.row = 2, layout.pos.col = 5)) +# print(pg, vp = viewport(layout.pos.row = 2, layout.pos.col = 6)) +# +# +# print(NFIplots[[2]], vp = viewport(layout.pos.row = 2, layout.pos.col = 2)) +# print(NFIplots[[1]], vp = viewport(layout.pos.row = 2, layout.pos.col = 3)) +# grid.text("PGE calibration", gp=gpar(cex=1.3), +# vp = viewport(layout.pos.row = 3, layout.pos.col = 1:3)) +# print(PGEplots[[3]], vp = viewport(layout.pos.row = 4, layout.pos.col = 1)) +# print(PGEplots[[2]], vp = viewport(layout.pos.row = 4, layout.pos.col = 2)) +# print(PGEplots[[1]], vp = viewport(layout.pos.row = 4, layout.pos.col = 3)) +# diff --git a/R/prebas.r b/R/prebas.r new file mode 100644 index 0000000..a04be98 --- /dev/null +++ b/R/prebas.r @@ -0,0 +1,170 @@ + +prebas <- function(nYears, + pCROBAS = pCROB, + pPRELES = pPREL, + PREBASversion = 0, + etmodel = 0, + pYASSO = pYAS, + pAWEN = parsAWEN, + siteInfo = NA, + thinning=NA, + initClearcut = c(1.5,0.5,0.0431969,0.,0.), + fixBAinitClarcut = 1., + initCLcutRatio = NA, + PAR,TAir,VPD,Precip,CO2, + P0=NA, + initVar = NA, + soilC = NA, + weatherYasso = NA, + litterSize = NA, + soilCtot = NA, + defaultThin = 1., + ClCut = 1., + inDclct = NA, + inAclct = NA, + yassoRun = 0){ + + ###process weather### + if(length(PAR) >= (nYears*365)){ + PAR = PAR[1:(nYears*365)] + TAir = TAir[1:(nYears*365)] + VPD = VPD[1:(nYears*365)] + Precip = Precip[1:(nYears*365)] + CO2 = CO2[1:(nYears*365)] + } else{ + stop("daily weather inputs < nYears*365") + } + ### + + ###proc thinnings## + if(all(is.na(thinning))) thinning=matrix(0,1,8) + thinning[is.na(thinning)] <- -999 + nThinning = max(1,nrow(thinning)) + thinning <- thinning[order(thinning[,2],thinning[,1],thinning[,3]),] + ### + if(all(is.na(initVar))) { + nLayers <- 3 }else { + nLayers <- ifelse(is.null(ncol(initVar)),1,ncol(initVar)) + } + nSp = ncol(pCROBAS) + if(anyNA(siteInfo)) siteInfo = c(1,1,3,160,0,0,20) ###default values for nspecies and site type = 3 + + if(all(is.na(initCLcutRatio))){ + initCLcutRatio <- rep(1/nLayers,nLayers) + } + + varNam <- getVarNam() + nVar <- length(varNam) + + layerNam <- paste("layer",1:nLayers) + output <- array(0, dim=c((nYears),nVar,nLayers,2), + dimnames = list(NULL,varNam,layerNam,c("stand","thinned"))) + fAPAR <- rep(0.7,nYears) + + ###compute ETS year + Temp <- TAir[1:(365*nYears)]-5 + ETS <- pmax(0,Temp,na.rm=T) + ETS <- matrix(ETS,365,nYears); ETS <- colSums(ETS) + + ###if P0 is not provided use preles to compute P0 + if(is.na(P0)){ + P0 <- PRELES(DOY=rep(1:365,nYears), + PAR=PAR,TAir=TAir,VPD=VPD,Precip=Precip,CO2=CO2, + fAPAR=rep(1,length(PAR)),LOGFLAG=0,p=pPRELES)$GPP + P0 <- matrix(P0,365,nYears);P0 <- colSums(P0) + } + + ETSthres <- 1000; ETSmean <- mean(ETS) + + ####process clearcut + if(any(!is.na(c(inDclct,inAclct)))){ + if(is.na(inDclct)) inDclct <- 9999999.99 + if(is.na(inAclct)) inAclct <- 9999999.99 + } + # if(ClCut==1 & all(is.na(initVar)) & is.na(inDclct)) inDclct <- + if(ClCut==1 & all(is.na(inDclct))) inDclct <- + c(ClCutD_Pine(ETSmean,ETSthres,siteInfo[3]), + ClCutD_Spruce(ETSmean,ETSthres,siteInfo[3]), + ClCutD_Birch(ETSmean,ETSthres,siteInfo[3])) + # if(ClCut==1 & all(is.na(initVar)) & is.na(inAclct)) inAclct <- + if(ClCut==1 & all(is.na(inAclct))) inAclct <- + c(ClCutA_Pine(ETSmean,ETSthres,siteInfo[3]), + ClCutA_Spruce(ETSmean,ETSthres,siteInfo[3]), + ClCutA_Birch(ETSmean,ETSthres,siteInfo[3])) + if(any(is.na(inDclct))) inDclct[is.na(inDclct)] <- 9999999.99 + if(length(inDclct)==1) inDclct<- rep(inDclct,nSp) + if(any(is.na(inAclct))) inAclct[is.na(inAclct)] <- 9999999.99 + if(length(inAclct)==1) inAclct<- rep(inAclct,nSp) + +###if any initial value is given the model is initialized from plantation + if (all(is.na(initVar))){ + initVar <- matrix(NA,6,nLayers) + initVar[1,] <- 1:nLayers + initVar[3,] <- initClearcut[1]; initVar[4,] <- initClearcut[2] + initVar[5,] <- initClearcut[3]/nLayers; initVar[6,] <- initClearcut[4] + } + + xx <- min(10,nYears) + Ainit = 6 + 2*3.5 - 0.005*(sum(ETS[1:xx])/xx) + 2.25 + initVar[2,which(is.na(initVar[2,]))] <- initClearcut[5] <- round(Ainit) + + ####process weather PRELES (!!to check 365/366 days per year) + weatherPreles <- array(c(PAR,TAir,VPD,Precip,CO2),dim=c(365,nYears,5)) + weatherPreles <- aperm(weatherPreles, c(2,1,3)) + + ###initialise soil inputs + if(all(is.na(soilCtot))) soilCtot = numeric(nYears) + if(all(is.na(soilC))) soilC = array(0,dim = c(nYears,5,3,nLayers)) + if(all(is.na(litterSize))){ + litterSize = matrix(0,3,nLayers) + litterSize[2,] <- 2 + for (i in 1:nLayers) litterSize[1,i] <- ifelse(initVar[1,i]==3,10,30) + } + +##process weather inputs for YASSO + if(all(is.na(weatherYasso))){ + weatherYasso = matrix(0,nYears,3) + weatherYasso[,1] = aTmean(TAir,nYears) + weatherYasso[,3] = aTampl(TAir,nYears) + weatherYasso[,2] = aPrecip(Precip,nYears) + } + + PREBASversion <- paste("prebas_v",PREBASversion,sep='') + + prebas <- .Fortran(PREBASversion, + nYears=as.integer(nYears), + nLayers=as.integer(nLayers), + nSp=as.integer(nSp), + siteInfo = as.numeric(siteInfo), + pCROBAS = as.matrix(pCROBAS), + initVar=as.matrix(initVar), + thinning=as.matrix(thinning), + output=as.array(output), + nThinning=as.integer(nThinning), + maxYearSite=as.integer(nYears), + fAPAR=as.numeric(fAPAR), + initClearcut=as.numeric(initClearcut), + fixBAinitClarcut=as.numeric(fixBAinitClarcut), + initCLcutRatio = as.double(initCLcutRatio), + ETS = as.numeric(ETS), + P0 = as.numeric(P0), + weather=as.array(weatherPreles), + DOY= as.integer(1:365), + pPRELES=as.numeric(pPRELES), + etmodel = as.integer(etmodel), + soilC = as.array(soilC), + pYASSO=as.numeric(pYASSO), + pAWEN = as.matrix(pAWEN), + weatherYasso = as.matrix(weatherYasso), + litterSize = as.matrix(litterSize), + soilCtot=as.numeric(soilCtot), + defaultThin=as.double(defaultThin), + ClCut=as.double(ClCut), + inDclct=as.double(inDclct), + inAclct=as.double(inAclct), + dailyPRELES = matrix(-999,(nYears*365),3), + yassoRun=as.double(yassoRun)) + class(prebas) <- "prebas" + return(prebas) +} + diff --git a/R/utilStaff.r b/R/utilStaff.r new file mode 100644 index 0000000..b6fdeb3 --- /dev/null +++ b/R/utilStaff.r @@ -0,0 +1,26 @@ + getVarNam <- function(){ + return(c('siteID','climID','sitetype','species','ETS' ,'P0','age', 'DeadWoodVolume', 'Respi_tot','GPP/1000', + 'H','D', 'BA','Hc_base','Cw','Lc','N','npp','leff','keff','lproj','ET_preles','weight', + 'Wbranch',"WfineRoots",'Litter_fol','Litter_fr','Litter_branch','Litter_wood','V', + 'Wstem','W_croot','wf_STKG', 'wf_treeKG','B_tree','Light',"Vharvested","Wharvested","soilC", + "aSW","summerSW","Vmort","gross growth", "GPPspecies","Rh species", "NEP sp")) +} + + + aTmean <- function(TAir,nYears){ + Tmean = colMeans(matrix(TAir,365,nYears)) + return(Tmean) + } + + aTampl <- function(TAir,nYears){ + monthsDays <- c(rep(1,31),rep(2,28),rep(3,31),rep(4,30),rep(5,31),rep(6,30), + rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) + TbyYear <- matrix(TAir,365,nYears) + Tampl = apply(TbyYear, 2, function(x) max(aggregate(x,by=list(monthsDays),FUN=mean)) - min(aggregate(x,by=list(monthsDays),FUN=mean)) ) + return(Tampl) + } + + aPrecip <- function(Precip,nYears){ + aP = colSums(matrix(Precip,365,nYears)) + return(aP) + } diff --git a/R/yasso_routines.r b/R/yasso_routines.r new file mode 100644 index 0000000..6130ef9 --- /dev/null +++ b/R/yasso_routines.r @@ -0,0 +1,497 @@ +library(Matrix) + + +Yasso15Parameters<- c(4.8971473e-01, 4.9138734e+00, 2.4197346e-01, 9.4876416e-02, + 4.3628932e-01, 2.4997402e-01, 9.1512685e-01, 9.9258227e-01, 8.3853738e-02, 1.1476783e-02, 6.0831497e-04, 4.7612821e-04, 6.6037729e-02, 7.7134168e-04, 1.0401742e-01, 6.4880756e-01, + -1.5487177e-01, -1.9568024e-02, -9.1717130e-01, -4.0359430e-04, -1.6707272e-04, + 9.0598047e-02, -2.1440956e-04, 4.8772465e-02, -7.9136021e-05, 3.5185492e-02, -2.0899057e-04, -1.8089202e+00, -1.1725473e+00, -1.2535951e+01, + 4.5964720e-03, 1.3025826e-03, + -4.3892271e-01, 1.2674668e+00, 2.5691424e-01) + +# This file is the Yasso15 model core code that is an improved and updated version based on +# Yasso07 description Tuomi & Liski 17.3.2008 (Yasso07.pdf) +# and Taru Palosuo's code in December 2011 +# +# This version uses the separate temperature/precipitation dependencies for the N and H compartments +# The parameters were estimated using e.g. the additional global scale Zinke data set +# +# Possibility to compute model prediction for steady state conditions has been included this version. +# +# Last edited 24.8.2015 +# - Marko J??rvenp???? + + +# Instructions IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII + +# 1) first run the source code for the function with "source(....r)" +# 2) then you can use the Yasso-function by just calling it Yasso15_R_version(...) +# 3) Input for the function: +# 1. Yasso15Parameters - Yasso parameters as a vector, length 35 +# 1-16 matrix A entries: 4*alpha, 12*p +# 17-21 Leaching parameters: w1,...,w5 IGNORED IN THIS FUNCTION +# 22-23 Temperature-dependence parameters for AWE fractions: beta_1, beta_2 +# 24-25 Temperature-dependence parameters for N fraction: beta_N1, beta_N2 +# 26-27 Temperature-dependence parameters for H fraction: beta_H1, beta_H2 +# 28-30 Precipitation-dependence parameters for AWE, N and H fractions: gamma, gamma_N, gamma_H +# 31-32 Humus decomposition parameters: p_H, alpha_H (Note the order!) +# 33-35 Woody parameters: theta_1, theta_2, r +# 2. SimulationTime - time when the result is requested [a] +# 3. MeanTemperature - mean annual temperature [C] +# 4. TemperatureAmplitude - temperature amplitude i.e. (T_max-T_min)/2, [C] +# 5. Precipitation - annual precipitation [mm] +# 6. InitialCPool - initial C pools of model compartments, length 5, [whatever] +# 7. LitterInput - mean litter input, 5 columns AWENH, must be the same unit as InitialCpool per year +# 8. WoodySize - size of woody litter (for non-woody litter this is 0) [cm] +# 9. Steadystate_pred - set to 1 if ignore 'SimulationTime' and compute solution +# in steady-state conditions (which sould give equal solution as if time is set large enough) +# 4) The function returns the amount of litter as 5-vector (AWENH compartments) at SimulationTime +# (or as time is infinity) + +# NOTE that this function eats only one type of material at the time. So, non-woody and different woody litter +# materials needs to be calculated separately (and finally count together if desired). + +# The output of the function is the vector AWENH compartments at the given time since the simulation start + + +# Basics BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB + +# additional R libraries (as needed) +#library(Matrix) # tai Matrix tms + + +# Function definition FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + +Yasso15_R_version <- function(Yasso15Parameters, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, InitialCPool, LitterInput, WoodySize, Steadystate_pred = 0) +{ + + # using shorter names for input + theta <- Yasso15Parameters + t <- SimulationTime + climate <- c(MeanTemperature,Precipitation,TemperatureAmplitude) + init <- InitialCPool + b <- LitterInput + d <- WoodySize + + # temperature annual cycle approximation + te1 <- climate[1]+4*climate[3]/pi*(1/sqrt(2)-1) + te2 <- climate[1]-4*climate[3]/(sqrt(2)*pi) + te3 <- climate[1]+4*climate[3]/pi*(1-1/sqrt(2)) + te4 <- climate[1]+4*climate[3]/(sqrt(2)*pi) + + # Average temperature dependence + te <- c(te1,te2,te3,te4) + tem <- mean(exp(theta[22]*te+theta[23]*te^2)) + temN <- mean(exp(theta[24]*te+theta[25]*te^2)) + temH <- mean(exp(theta[26]*te+theta[27]*te^2)) + + # Precipitation dependence + tem <- tem*(1.0-exp(theta[28]*climate[2]/1000.0)) # precipitation as m + temN <- temN*(1.0-exp(theta[29]*climate[2]/1000.0)) + temH <- temH*(1.0-exp(theta[30]*climate[2]/1000.0)) + + # Size class dependence -- no effect if d == 0.0 + size_dep <- min(1.0,(1+theta[33]*d+theta[34]*d^2)^(-abs(theta[35]))) + + # check rare case where no decomposition happens for some of the compartments + # (basically, if no rain) + if(tem <= 1e-16) + { + xt <- init + b*t; + return(xt); + } + + # Calculating matrix A (will work ok despite the sign of alphas) + + alpha <- abs(c(theta[1], theta[2], theta[3], theta[4], theta[32])) # Vector of decomposition rates + + # Creating the matrix A_p + row1 <- c(-1, theta[5], theta[6], theta[7], 0) + row2 <- c(theta[8], -1, theta[9], theta[10], 0) + row3 <- c(theta[11], theta[12], -1, theta[13], 0) + row4 <- c(theta[14], theta[15], theta[16], -1, 0) + row5 <- c(theta[31], theta[31], theta[31], theta[31], -1) + A_p <- matrix(c(row1, row2, row3, row4, row5), 5, 5, byrow=T) # A_p is now computed + + # computing the diagonal coefficient matrix k + k <- diag(c(tem*alpha[1:3]*size_dep,temN*alpha[4]*size_dep,temH*alpha[5])) # no size effect in humus + + A <- A_p%*%k # coefficient matrix A is now computed + + # Solve the differential equation x'(t) = A(theta)*x(t) + b, x(0) = init + if (Steadystate_pred) + { + # Solve DE directly in steady state conditions (time = infinity) + # using the formula 0 = x'(t) = A*x + b => x = -A^-1*b + xt <- solve(-A,b) + xt <- as.matrix(xt) + } else + { + # Solve DE in given time using the analytical formula + z1 <- A %*% init + b; + mexpAt <- expm(A*t) + z2 <- mexpAt %*% z1 - b + xt <- as.matrix(solve(A,z2)) + } + return(xt) + +} # end of Yasso15 function + + +# Note for Birch Betula pubenscens and brown leaves is used + +foliage.AWEN <- function(Lf, spec) { + + fol.AWEN <- matrix(0,nrow=length(Lf), ncol=4) + + ma <- (1:length(Lf))[spec==1] + + ku <- (1:length(Lf))[spec==2] + + ko <- (1:length(Lf))[spec==3] + + fol.AWEN[,1][ma] <- 0.518*Lf[ma] + + fol.AWEN[,1][ku] <- 0.4826*Lf[ku] + + fol.AWEN[,1][ko] <- 0.4079*Lf[ko] + + fol.AWEN[,2][ma] <- 0.1773*Lf[ma] + + fol.AWEN[,2][ku] <- 0.1317*Lf[ku] + + fol.AWEN[,2][ko] <- 0.198*Lf[ko] + + fol.AWEN[,3][ma] <- 0.0887*Lf[ma] + + fol.AWEN[,3][ku] <- 0.0658*Lf[ku] + + fol.AWEN[,3][ko] <- 0.099*Lf[ko] + + fol.AWEN[,4][ma] <- 0.216*Lf[ma] + + fol.AWEN[,4][ku] <- 0.3199*Lf[ku] + + fol.AWEN[,4][ko] <- 0.2951*Lf[ko] + + return(fol.AWEN) + +} + +## Branches are here + +# It seems that there is only valiues for pine (these are applied for others as well) + + + +branches.AWEN <- function(Lb) { + + fb.AWEN <- matrix(0,nrow=length(Lb), ncol=4) + + a <- c(0.4763,0.4933,0.4289,0.5068,0.4607,0.5047,0.4642,0.5307,0.5256,0.4661,0.5060, + + 0.4941,0.4848,0.4158,0.4605,0.4423,0.4811,0.4434,0.5141,0.4312,0.4867,0.3997,0.4758,0.4741,0.4996) + + w <- c(0.0196,0.0105,0.0197,0.0120,0.0107,0.0106,0.0130,0.0126,0.0116,0.0195,0.0180, + + 0.0257,0.0219,0.0295,0.0242,0.0198,0.0242,0.0263,0.0188,0.0218,0.0207,0.0234,0.0176,0.0248,0.0188) + + e <- c(0.0870,0.0659,0.1309,0.0506,0.0874,0.0519,0.0840,0.0382,0.0394,0.0996,0.0647, + + 0.0905,0.0633,0.1131,0.0874,0.1101,0.0681,0.1108,0.0561,0.1128,0.0452,0.1161,0.0678,0.0698,0.0470) + + n <- c(0.4170,0.4303,0.4205,0.4306,0.4412,0.4328,0.4388,0.4186,0.4234,0.4148,0.4112, + + 0.4456,0.4300,0.4416,0.4279,0.4278,0.4266,0.4195,0.4110,0.4341,0.4474,0.4608,0.4388,0.4313,0.4346) + + fb.AWEN[,1] <- mean(a)*Lb + + fb.AWEN[,2] <- mean(w)*Lb + + fb.AWEN[,3] <- mean(e)*Lb + + fb.AWEN[,4] <- mean(n)*Lb + + return(fb.AWEN) + +} + + + +stem.AWEN <- function(Lst, spec) { + + st.AWEN <- matrix(0,nrow=length(Lst), ncol=4) + + ma <- (1:length(Lst))[spec==1] + + ku <- (1:length(Lst))[spec==2] + + ko <- (1:length(Lst))[spec==3] + + st.AWEN[,1][ma] <- 0.5*(0.66+0.68)*Lst[ma] + + st.AWEN[,1][ku] <- 0.5*(0.63+0.7)*Lst[ku] + + st.AWEN[,1][ko] <- 0.5*(0.65+0.78)*Lst[ko] + + st.AWEN[,2][ma] <- 0.5*(0.03+0.015)*Lst[ma] + + st.AWEN[,2][ku] <- 0.5*(0.03+0.005)*Lst[ku] + + st.AWEN[,2][ko] <- 0.5*(0.03+0)*Lst[ko] + + st.AWEN[,3][ma] <- 0.5*(0+0.015)*Lst[ma] + + st.AWEN[,3][ku] <- 0.5*(0+0.005)*Lst[ku] + + st.AWEN[,3][ko] <- 0 + + st.AWEN[,4][ma] <- 0.5*(0.28+0.29)*Lst[ma] + + st.AWEN[,4][ku] <- 0.5*(0.33+0.28)*Lst[ku] + + st.AWEN[,4][ko] <- 0.5*(0.22+0.33)*Lst[ko] + + return(st.AWEN) + +} + +#YAsso function that to be used in R function apply +yasso <- function(input,pYasso,yassoOut){ + SimulationTime <- t + Steadystate_pred <- Steadystate_pred + MeanTemperature <- input[1] + TemperatureAmplitude <- input[2] + Precipitation <- input[3] + InitialCPool <- input[4:8] + LitterWp <- c(stem.AWEN(input[9],1),0) + LitterfWp <- c(branches.AWEN(input[10]),0) + LitterFp <- c(foliage.AWEN(input[11],1),0) + LitterWsp <- c(stem.AWEN(input[12],2),0) + LitterfWsp <- c(branches.AWEN(input[13]),0) + LitterFsp <- c(foliage.AWEN(input[14],2),0) + LitterWb <- c(stem.AWEN(input[15],3),0) + LitterfWb <- c(branches.AWEN(input[16]),0) + LitterFb <- c(foliage.AWEN(input[17],3),0) + sizeWp <- input[18] + sizefWp <- input[19] + sizeWsp <- input[20] + sizefWsp <- input[21] + sizeWb <- input[22] + sizefWb <- input[23] + + # run yasso for Woody in pine stands + yassoOut[1,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[1,], LitterWp, sizeWp, Steadystate_pred) + # run yasso for fine Woody in pine stands + yassoOut[2,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[2,], LitterfWp, sizefWp, Steadystate_pred) + # run yasso for foliage in pine stands + yassoOut[3,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[3,], LitterFp, 0, Steadystate_pred) + # run yasso for Woody in spruce stands + yassoOut[4,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[4,], LitterWsp, sizeWsp, Steadystate_pred) + # run yasso for fine Woody in spruce stands + yassoOut[5,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[5,], LitterfWsp, sizefWsp, Steadystate_pred) + # run yasso for foliage in spruce stands + yassoOut[6,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[6,], LitterFsp, 0, Steadystate_pred) + # run yasso for Woody in birch stands + yassoOut[7,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[7,], LitterWb, sizeWb, Steadystate_pred) + # run yasso for fine Woody in birch stands + yassoOut[8,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[8,], LitterfWb, sizefWb, Steadystate_pred) + # run yasso for foliage in birch stands + yassoOut[9,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[9,], LitterFb, 0, Steadystate_pred) + return(yassoOut) +} + + +compAWENH <- function(Lit,parsAWEN,spec,litType){ + #litType if 1 uses Foliage pars, 2 branches, 3 woody + #spec vector with species + #parsAWEN matrix with parameters and columns = species + #Lit litter + AWENH = numeric(5) + AWENH[1] = parsAWEN[((litType-1)*4)+1,spec]*Lit + AWENH[2] = parsAWEN[((litType-1)*4)+2,spec]*Lit + AWENH[3] = parsAWEN[((litType-1)*4)+3,spec]*Lit + AWENH[4] = parsAWEN[((litType-1)*4)+4,spec]*Lit + return(AWENH) +} + + +#YAsso function that to be used in R function apply +yassoStSt <- function(SimulationTime,Steadystate_pred, + MeanTemperature,TemperatureAmplitude,Precipitation, + Lit.W,lit.fW,litt.F,InitialCPool, + pYasso){ + + apply(ciao,stem.AWEN,1) + LitterWp <- c(stem.AWEN(input[9],1),0) + LitterfWp <- c(branches.AWEN(input[10]),0) + LitterFp <- c(foliage.AWEN(input[11],1),0) + LitterWsp <- c(stem.AWEN(input[12],2),0) + LitterfWsp <- c(branches.AWEN(input[13]),0) + LitterFsp <- c(foliage.AWEN(input[14],2),0) + LitterWb <- c(stem.AWEN(input[15],3),0) + LitterfWb <- c(branches.AWEN(input[16]),0) + LitterFb <- c(foliage.AWEN(input[17],3),0) + sizeWp <- input[18] + sizefWp <- input[19] + sizeWsp <- input[20] + sizefWsp <- input[21] + sizeWb <- input[22] + sizefWb <- input[23] + + # run yasso for Woody in pine stands + yassoOut[1,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[1,], LitterWp, sizeWp, Steadystate_pred) + # run yasso for fine Woody in pine stands + yassoOut[2,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[2,], LitterfWp, sizefWp, Steadystate_pred) + # run yasso for foliage in pine stands + yassoOut[3,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[3,], LitterFp, 0, Steadystate_pred) + # run yasso for Woody in spruce stands + yassoOut[4,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[4,], LitterWsp, sizeWsp, Steadystate_pred) + # run yasso for fine Woody in spruce stands + yassoOut[5,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[5,], LitterfWsp, sizefWsp, Steadystate_pred) + # run yasso for foliage in spruce stands + yassoOut[6,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[6,], LitterFsp, 0, Steadystate_pred) + # run yasso for Woody in birch stands + yassoOut[7,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[7,], LitterWb, sizeWb, Steadystate_pred) + # run yasso for fine Woody in birch stands + yassoOut[8,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[8,], LitterfWb, sizefWb, Steadystate_pred) + # run yasso for foliage in birch stands + yassoOut[9,] <- Yasso15_R_version(pYasso, SimulationTime, MeanTemperature, TemperatureAmplitude, + Precipitation, yassoOut[9,], LitterFb, 0, Steadystate_pred) + + return(yassoOut) +} + + + + +####below are the functions to compute soil steady state carbon from prebas output + +StStYasso <- function(litter,parsAWEN,spec,Tmean,Tamp,Precip,litterSize,litType,pYasso, + t=1, stst=1,soilCin=rep(0,5)){ + AWEN <- compAWENH(litter,parsAWEN,spec,litType) + + soilC <- Yasso15_R_version(pYasso, SimulationTime=t, Tmean, + Tamp, Precip,soilCin, + AWEN, litterSize, + Steadystate_pred=stst) + return(soilC) +} + +ageEndRot <- function(x){ + if(inherits(x,"prebas")){ + nYearsStst = x$output[(which(x$output[,30,1,1]==0)[1]),7,1,1] + } + if(inherits(x,"multiPrebas") | inherits(x,"regionPrebas")){ + endRot <- apply(x$multiOut[,,30,1,1],1,function(aa) which(aa==0)[1]) + index <- matrix(c(1:x$nSites,endRot,rep(7,x$nSites),rep(1,x$nSites),rep(1,x$nSites)),7,5) + nYearsStst <- x$multiOut[index] + } + return(nYearsStst) +} + + +LitterforYassoStSt <- function(x,rot=1,years=NA){ + ###Function to extract litter from PREBAS output and + ###compute the average litter input for YASSO + ## x is a prebas output; rot = 1 the steady state soilC is calculated + ##on the rotation length; + ## years = number of years from which compute the average annual litter inputs; + if(inherits(x,"prebas")){ + if (rot==1) {nYearsStst = ageEndRot(x)} else if(!is.na(years)){ + nYearsStst=years}else{ + nYearsStst=length(x$output[,30,1,1]) + } + litterSize <- x$litterSize + nLayers <- x$nLayers + if(nLayers==1){ + input <- c(sum(colSums(x$output[1:nYearsStst,26:27,,1])),colSums(x$output[1:nYearsStst,28:29,,1]))/nYearsStst#array(0.,3,nLayers) + litter <- data.table(input) + setnames(litter,"layer 1") + litter[,"litterSize 1":=litterSize[3:1,1]][] + litter[,litType:=1:3] + # class(litter) <- "litterPrebas" + return(litter) + } else{ + input <- rbind(colSums(colSums(x$output[1:nYearsStst,26:27,,1])),colSums(x$output[1:nYearsStst,28:29,,1]))/nYearsStst#array(0.,3,nLayers) + litter <- data.table(input) + for(j in 1:nLayers) litter[,paste("litterSize",j):=litterSize[3:1,j]][] + litter[,litType:=1:3] +# class(litter) <- "litterPrebas" + return(litter)} + } + # if(inherits(x,"multiPrebas")){ + # nSites <- x$nSites + # if (rot==1) {nYearsStst = ageEndRot(x)} else if(!is.na(years)){ + # nYearsStst=years}else{ + # nYearsStst=length(x$output[,30,1,1]) + # } + # litterSize <- x$litterSize + # nLayers <- x$nLayers + # folLit <- x$multiOut[,,26,,1] + x$multiOut[,,27,,1] + # litter <- + # input <- apply(x$multiOut,1,function(ops) rbind(colSums(colSums(ops[1:nYearsStst,26:27,,1])),colSums(ops[1:nYearsStst,28:29,,1])))#/nYearsStst#array(0.,3,nLayers) + # litter <- data.table(input) + # for(j in 1:nLayers) litter[,paste("litterSize",j):=litterSize[3:1,j]][] + # litter[,litType:=1:3] + # # class(litter) <- "litterPrebas" + # return(litter) + # } +} + + + + +soilCstst <- function(litter,Tmean,Tamp,Precip,species, ###species is a vector of species code with length = to nLayers + pAWEN = parsAWEN,pYasso=pYAS, + t=1,stst=1,soilCin=NA){ + + if(length(dim(litter))==2){ + litter <- data.table(litter) + nLayers <- (ncol(litter)-1)/2 + if(is.na(soilCin)) soilCin <- array(0,dim=c(5,3,nLayers)) + soilC = array(0,dim = c(5,3,nLayers)) + + setnames(litter, c(paste("layer", 1:nLayers),paste("litterSize", 1:nLayers),"litType")) + layersNam <- names(litter[,1:nLayers]) + litterSizeNam <- names(litter[,(nLayers+1):(nLayers*2)]) + + for(j in 1:nLayers) soilC[,,j] <- matrix(unlist(litter[, + .(list(StStYasso(get(layersNam[j]), + parsAWEN=pAWEN,spec=species[j],Tmean,Tamp,Precip, + get(litterSizeNam[j]),`litType`,pYasso, + t=t,stst=stst,soilCin = soilCin[,,j]))), + by=1:nrow(litter)][,2]),5,3) + return(soilC) + } +} + + + +sCststPrebasOut <- function(x){ + litter <- LitterforYassoStSt(x)[] + Tmean <- mean(x$weatherYasso[,1]) + Tamp <- mean(x$weatherYasso[,3]) + Precip <- mean(x$weatherYasso[,2]) + soilStSt <- soilCstst(litter, Tmean,Tamp,Precip) + return(soilStSt) +} + + diff --git a/Rprebasso.Rproj b/Rprebasso.Rproj new file mode 100644 index 0000000..8e3c2eb --- /dev/null +++ b/Rprebasso.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/data/ClCut.rdata b/data/ClCut.rdata new file mode 100644 index 0000000000000000000000000000000000000000..8fbb2c663f208b5bb76838226c57e1fc04919102 GIT binary patch literal 308 zcmV-40n7d$iwFP!000002Gx?^Pr@(|$Io^?Folr#YWNeD2pSbyGQy8%qC5~@%-m*1 zGJ&)szVer&x2N%7P*c?6aHgxyJS+RSv(M=K$m-;B6@11L7tNxH zGT0b-!*Spj4fgQIBhiM>n;RBZ_$O7*}U{6+hO{~8>vsbF` zks0Hi%HjOJa{BxM7klfj>yp0Qh;3-{uNN-{&_dlBK2ywd*2HIuarcNZsoo{8MZW(I zDb=;kQgn0%F`>0hPMs5+u1ZetOA#j4Hzj^wVPL;7FeQaced8XS$@|Z^VE+Rpe++u; G0{{Tb9GQ^- literal 0 HcmV?d00001 diff --git a/data/parameters.RData b/data/parameters.RData new file mode 100644 index 0000000000000000000000000000000000000000..fc3243bd4932c612ebe9a4b0d1532d5aa1d9d1ea GIT binary patch literal 1759 zcmV<51|az#iwFP!0000029;F_P*YbF{VahH*)(WXoR*g2E+vSdwe)@z6jZbjN)&DN zlSQI|gddQ_inVAXqJj#dsMM{kTP;;Y#127mU_jZ!l8S7KB5Sp@P(|!d@_&Z>I%E50 zl6%j6@8A30edpa9=)KyNwVH(>h%sVfYKj<}5UQy$@n?jXA{K;X$}n8+#q(K-ASP@A zYZh1&KTBvm6!q(-gcnf!%N^G;-Z{vUc;f7w!B{Z zA;=jsve2a63hpO4cP?v4hYs1929{?eWUxFn8YJWebnkjM4{Ef~Qy-_fy?e^y+22Fq z{p3rLmRBLW(YuO$ekQ2mJk{GnufILc(#v-7ZN6|o<2|4U1o3TzWh>NbVD~P4oZsx3 zna0shP`cVS)W7CA+#qEQ8UJl@9=B-&!G7I25OP5EQO(Gt<&_bEg$w0`VyjK6&S)wV zM+iyXOfJKt`4nP=igA7z-3MQS$tfR{ktM*QFlP}?xTh_*z@;(Hqr+NKcPx@h#Mnlm z7Y*}h*oTH!lGr>H$0GP)UWSlo2z?A8^({jlB@Fi(4S1u0&uBn!5E-H8K(;t=)gpqw znoE?zy~_yugAxxkOz6MA`f)7kX3Vg?Wa|XjwO657RmMj5f*9yHr&*$9tFQg)Ff`kf>XUH&D~4)oA&9Zu7IhX(29Q8%3|WGv9Iw-zo< z|MParx*5tW8Y%BAzv&ziQi+PX@}GVBr5trLOF$gUa-oW$I>wDpKpmr}Ph20e4Te8C zpZ(q*GpL58d;iGX2BnqFk9xX)fHL%#!y9^)kW~`8)_l$@c&9!mc2JejBOF#GVqM{s!_eARm(>|c2* zE-$!r?lBA9Z0d^ih4iA{zKLny;8viTKgX=KB>?*F980~Q8v=ty`_jc}$#9SPe&5r8 zdT79GHYM%$gnP2J9wqIKkX1K$B3kqWUQbW;@OH9-!G5MoYxP}d>}4oMj_-mN>zprF z9B@b1_ywh%y50jvUgeh5@4kqpo>E`E)nNkaU%O^ZZQo1rNx#2(-8rF^#1xM@N!&;B zi^d~;zW!^TSQ-0PwJa3CEnP9C=ZW?xO$6d_LRcZ1zJef5h_-JS_7!3YRg2ifRDK~NsW!@Yp6h~0?P3|J+V-l)x8^uz`zN2L&y0-o<8ds%bcGEr0D2D>wOGlaH3wY90 z40hwpP^TtssVrn_3xYk$(J@?^zijXL6-U;?>53(Osgg42e6)X0Wb-EK#VH$>7ysCQ z;tEu6@JjMnUIJY=98VvQ$%HGF>8j3`M$kX3F~mYsa9!nv^6%geveJ}eSb;AU^>?zaxIpQso8(3b&zOSWc@%|8nHC)@cRX0PB;5p!D4Wjke2O?{2UifmfZl(gr%G%NJ-DwHmDqa7CdRJ?}+mG?ZUGszfc#>7#C)tN}mXL zZK3tW=iTr*FTC;m?1RdtcUFCpFfSDbmL|tfajJr&?V9eQX-)s9nuN{B2v=b-8I0_txbIrlAbgdimLgP(0|m0A5s`bF%w6oJyr$HNq zmZ;Ie4eoUanfPh1`YnaD+qujo#UAYlRzkvIL*mi8NeWZu&4Cy0vG>bE&>v7B?cTPH z1Hvwl^>ld<`pEn(^4Jc8fJB^G-Z9;e{4YRovp8W9koN!O`+o}}Xlkap5!Iwe|DPBH zH~uv89)~!(|2KdU!6pAMfM|$I%tT&!H9q?I>Mj1q2THB))KG~TfizQFbkm;EqT=dR zO>+SSWlf&m&jLESXiuK*!CUyQ6Drq0x063G_v+cK=|u>tvL?#Wh5!=DndKQWf1PzN zadmD|;o^@$^CaEgQX$xytGL~d&jYhg+_a8%SqUXpp1-kiv1^>iY;n2 zw7CB4QGV2zB;u!p>Z;@(pK^|}ZE#`h>*_G^tDJxcIX9BB6AuB7OjxRu>08g(uF&%5 z=l@*$S#(r~A=_uO-_>o80zhgcHJg2#0ewD**=2NsyAQMMjIr$(t%);!@vB)3MyuWC z=a$P)A$Dg~*-xh77heb$EZfK4q$Z4p5W9A@J)AYpo>`QAO@8Pp-}aX!&Z&wDMrv^# zH|j8gNFgs$we^))Ty6?QWTMYj=FRNUK;54{T6vA;OT;{8$*5g_j-wO5+T8;U z#1=TYh3S7uzkSSdtE4#YFF-JR6(-keHyP^`Sls#DJswvy{m0qn->X*cqbk-7{^8!j zRR7@9lBQFpUd4$6r`n7FpG3+-#W}I=0W-o`V{FFV_U(*u!)0?)x^x-)$7H4tu2I+F z4$`!g;mh0S12@h@v+V^mr(U&6=Icu_z{8nk)$*@NyL{r=kHoD$%K=a*3yXj38n$&| ziFZnSv&MQkuW~l@#3d?nB%AC3seRmzp0|eSPIRAn$3taG`?210{*JTD4r0y46hZRUfr;zrfes~5BeyQF@VXNOzDLHKM40`{9* z!EZlb;m!InHC3~&(oSvqhHeVcE!6${YTm&(yD)`wvM|wTU8Q94q35lTFO}HZ{Rv`djl7eo&=q zzRY{k6eqcMPbLK4P|BE?5DXAdQip`K}j zR-$*fA%8?C89Y-AZNZ`Vqm`W^zG!wiLC^pA#ua+9w=8N3wHM2%*vJ>zC%wNWS?j@L zdK;0SzQUD1q_h%bPOr+%AMz&zx<+~@EAokO=ApnjmOe)hI#$%N@weNlHcV$+Y#uMQ zBBe^*T_VbZwEY<_IC=EJVmqy48O_Q2SFm_*sIKxqp#C;sa^jw%YX$G{2Dj){MOSvh z`1`Xr@2l`LGK$Uhgi7;!lV=n+ue_QR<-a96oqpZMeP&SI!g|~XbKDHb3qyQ*A0n6E z`{JWXX18JO?4Lu@oLmCfL^{(R|8<7NreT2zl_+FfxjG{p_r1H7X1gswO?&bYQ>t3S z-``6|rOz$Vr<8ou;#a7;(;xA5k@1A6U$d8yfpMB+-`zzOSMkLr=AE8-2j&G4F60A5s=erPB? zGq|W*_jv|Q0HdFG(04lC=n?FRh^l|_#)VCvxAgh<*!kNw&h@` z+XJ|2uX3?mBMCA*`vS$ZFsQe{TWbQm&f*DC_lZukhZLEn;uT(ea2AUkNNHR=w#y+j zzdPn#rtELM+|&(}gI{(0Z1I$V5?V;e_{&qL8n8B;;Z9%KcCCL7rdKRY_b_@2euYlI zYh00RqsBxaZqvm@f=<=a;%!*=>^Ve*34Ip`yh)9`P+G8o)!;Zc2IBws#!w)0zH!f45L8P0(l^B6%- zbl~n(JD_nfai*F;PWL^LZxEgAtbJIb%T+bWc-ulV^&uc^iukaESd*vwPo$+9J{7gn zfGgJ|pBlU?spCOFe?sLiNuG&1((Ca$)W8%WEF||n4#{{Emhe;@MH?pN6Qjl%G_i`k zn25NOn#kYIen1-H;G5$tf;p>QT#wTbMdK>9g#9CwNIX{FI0;7y6U*5e#oPg5I>Nju45ytm0j-Q3iIcMko>45ViX}VA z8ksSWlr$8WJhu$87`k1!X*~|HMs)2$u(uLFzDy~HL)X)|W#>~i*NQqI!4|b@;s)CC z$ycFv|(ukpjXpEK}g;`cWzu*lDmNF8@>f+e5FvTRNuu?+Kd|CW-b@bVF zc8Q~|CQMq%GVg$n*tSGcQ8;g=On)%P=-2q~M#nq(!RG^! zzl{RX+2B*`Q-kKMSUHe0#kB0(lIIO#5g2gP!*|+^Plt9qqe3RD7v2#MzP~1_l({O~sKvqpF8&ZJo z@V2%PfA+QHy)?>MP{+Sx;8Ir|R!B-1#abWweWl6+} zI)59ncFTMN4ce9b6-R#BkvHxTehb++ki8ThmWvfMqI?!*`I>jEg%pXq1U8X}rI|R2 zt5XNHjB050CdK#HhcGL6#fI}b+T}(wBe7fC1wdwK*3G;Cqdt@pF*-;KZTSqhI;BKP zGDcG#6_kijuM9EIi9KwBX8_1oWT@j^TGpM@Ml!1F*PTqey>+43qZ6}Uho;}2bJRbF? zxq2{4e@W)IeAIr^E8XnH7}g=IS%4(HYjeX5_CG{6f%;v|8lW8(znMM9qF|&E{o!8J zg-f5FBazJeo;UACVx*2uYCWD9LeIJmrm4HFeji#6d@YXc3v#XKZ8sJ#Gl@<6uoAt| z|L*&p37)U}Xe+xpbo$ne+P-!0j>Wa0-BJ&*zI@}+K0|dVaJ$eF0NA~^(^X(SzGcn{ zg6PIU*luE!yDo!MpD&(b<9d%obl+ra1et*=<=U^vt(?`YdT zY!NyNA8xT*MtM;vsyO7)2)!*1WFk8}?OW`FPlizmc`RRH24qlyLRFWZJJKh7WQj_^UWN2+saM>pv0^JI(r`iiax(~97 ztuqZaJWM+*)kkmM?)$DDa5j3fn}^DdQFMOpGGEytl*{_i{TM}j1xo9K=$J+ex9x-) zre>Bl#ghZ|TaZ|E@>#QH{i84@CrhBr2?3^uZ8nIP1Cx;X{ek#06}}_nFe8O@-*F&EUNR041#Q>n74g`S_GdpEQ2^XT?(K#P;f1RF z%+>#@I9ZdUROjX*d2FIf=kai=yy>fdG3zyy{95vlisKNz(Rp^y59^3*&Q&%llC>zyFa{TkbC70;O-#%lP`ix-$QvW$3)06b$wddnOQ z4-FwbvIQgdvwBT`n8B|lB?>q~YQl^i`fvj@O=V8Hr&hyAha_b$k#c z!7Nzi5t6#l_&cQ}7cwyS{Fmn}FLEhyg00G&i}dySUht5FCQT#grsqhW(5&Z0;Kxxq zj7D$!_RF92n0N@O=*l=&mjT`-A9iO$sbrOIFjjX21mHWsh$L)YD#1xZ&j&3H0k~?w zxV(@jfuiF<_XjVYsQWeakM4sL04Ry{baU95;J%GQf2r6NfTMVR5XphL6)3FB>I6h7 zerZ-j->`!tzh&sn!s-CHU$yE)$xHxTCfrGFPzV6}wauWI#zPP>Y0$H!mj;NM&$HR8 z@dHP~l{OW7)5!<~;<@X+^JoD7cqaY4Jjw3D?^XkFM$~EI+K_Z^Buvk3^^;%>Dq(80 z-vNMozjWN}7!AN5IddXG1Hh58Vmnv22tbq|D(6|iUwT0OZ{mRJNg6F@SV+4jEX410Ou4pYCZrQiOKuET?+z3 z>ywQ?I|(X9s&Hk39HXK4$sulXi2qJ1^S-<3t(4NM)TzDw9wmbN^V68s_z|)@YiHMT zc_0AyCyo;xd_;PO?$xYZOsB;}%Vas8_tRhoUN$(g+r;2VT;BBwD@YS&-Bn2Dvn23)*0(rdXFnn$SNV`xv z%mGUO>z)a6ZT4H2?+PGFHHv@dn=lyq>sCFb&SGXMcaoTDzk{&!@kjdKl9Zh|yDy1Q z#n4k^Iu{2)#0XEz1-(50KcFq+jYkLo=X4X>9e)Z~o_fL&utJAfbtq`JN(JB=?Af33 zasY78QLdJt-X};SXUl2@K25mDOuM|_U?dcBf93nf*@8e(#RBJf0*R~{AYmCo5N7F)cgNzlSv4NW9H>Rhi|_(8PWJGJuej;9F9`MdBWKM3!J zFW5zVH6ME4gA0I~JST|Y-SdjNBm_g#He5f(Cm_S3^WJ(B(S^VYTa z(Wf_LvS$FV$E{tdftUxA&im>)R;)_!eQjJ(si=sUMV=zl7%72XMBF+ul=LndEX_Ts zOG>a;sax+=LkCFds9j|k3{|EQHd|Ftflr5D>ffF5!%YZ20oOFePg3oGZJ(-)M;pD$29_OGx2eD~PzTDf%Fc{b8=D5@Y)+eTgc z+()1MY^I~}WC`wX7A^bm839p0S7K5`C;|BNq1@=b5_0M*S8T|>8oa?^Wz^B~Ee*d- zvrNR5uo8SGohmpb{ZUCR`VbT$b7x*#yJ*F!^eX-Ih zV^Ix`x-69B?erLpfxlt$R=M!iB*06H{RaDtFdaO@QDYeJf0zQBQ|yX{ejI_9rD6av3n7RGL;u zIx)_%<3--f@7vostI?EX8VRi3zou!72y)*MMjpp(*Zb(sl&b70Tl^S;1*)5!FM&hc zc1G%)`N#;uB}}SiKavtq^0a^4ln3C$3QFq&0|$d0Qlg0>2gt?jLC%r3e?CqOtcH>i z+-|J5h3HXSdfrzyK!I{EC?6Z(Dd=!KYA3Cr12m_L0t@130bg$c*C%DAo(ta1WNR?J z$90|ror>ouFz3<(Xu086!%D@dh@0v?=(2t8ym?J%pu+H)dVSh)ur@qLi@uYQ;0APW zpJ^%skE>Aox&V`-@<8g-Z~|<@-(~veZ{YW{qS>8*8%deN z<~_L7Mcbqz|8t<=-X z+W{eFd8z}J8WbtH)=-%ltu$?y5iRsx2{!rgoM(zB%4oGXE-6~)%7HWG`~e_brzT)~ zU7aS#xWwM52-qow>r4<vY_2_@0yzosZe@So-aZ2^P2ZEaPy;R173H;8swrKp})!6bhu|MrdHsQEHhPycn zY(?jd02pfJl)HaxFk@d=Rl(Q{z|9a2{iCP{;JUoN^q#B0`+ioh3fKZbf_($!B$2wZ zKBs00(P5cs^6TvHU%~J1WKp4Si7?GCE~#?3xxu?^$6UZllw50P#cFhOI1oNpkdVxdjb?q8Ozc0QO*zSr2~(#I5?) zKquFVyn0b8E*Uh(lJG0ZTkG^Ul5$9Kc8r&p=06Qj4y8w!<=8>GnRSa1cEwY0gGkZ% z){x4;%b$?>@WCpHlY5+iS^Qnqt`>hI#BarQeAhP$7i!}10lXnxU-@C~K?%Y}1-w%; zL*h6(D+(VB+AT=fLY2@f5A*wfhI)4Ar021owsp2Cnq;W2r9mp5Q$${I4a&gkk( zb5{Z}N_1xlV>4P5pQIsBxY&E0Tg<-?S?EB3T>$uutFI*U|LZdUE?7l=HNeF_GM|7; zmI@eitX2t|j5PEEa4MA_^QX1Q?#POZyT{?tEwRr! zKHyun5vfki9{}))o8G>4L>!4@6PdW$&N@9=8GMufB;mSs%DJ{dcRz5+ZU^8byjdl4Lb@;=zVb{%MqMvy01YJZj^#;kG+eD}#vhkN>Y zzPtIM3m`9YDBHoADM-A!ef$P(V<<=wnd3OT&$tuCd%)xctBU8aUR zF^u(%j|n12-#HFbwO_{z|`l=2H~xkW3$XB9=P)8Vb9{wT~Rl&fWTyflfC|7x_N`I+9UFwjnF zSL9g5^!OR*ICjr?B!lZ(2_m_-K+F~8xB)J1Yd(KBhR9H!R*3Gm{1MJ<934L5JKL*7 zjA3ow>5V6c2P_~#e+4lh1>K%&`moK3t-^xOjrZr|Cb2up99I$z208|GfB=#>4&hkD z+OEI(?c-$#=m`W=j~@gxp~cQ6{`bt;d#@Tneu14~eG@7|h_ts=X@wFGAe>kf_wYhn z?=`YU0l*E&4yI&Z35a{GcbL}V&agJPNTKTx4m_PFE6z4k1S)imE?;Q@h#>ZNTh|Z> zLvMkZ6!j54@O1S^D!Ag}K9x!bOe^EX4)SLXz1SAt%075AxZadH;xNqLdC@drU?eCY zmHr*CzD$r|4SJp4lf%s4IjB*?6+gxw*hc4~n_AE7Z@sqZG*BNY ztNps7my^HKvNF8QP8e8!)hjrTeoV;%2eu+@#CnwmnNH_GQ+!&3Q*#p? zCPiQ2DvLs3>FIY~4d|;tul@=+&gEZgm90R~=Bt`d{(`{%Egd@b=}LG_l47^SjlS2V zBFEQ+K{izL!sW_C0Sp3IbtCI4(Agrs@m1H3p|Y=oTl1X%6!JeWz$F zu7_kEo-6$&D}d32DJ@0!i+1=EM0clR3CH(?I0KadgyigR7M zX|ln~O7q9^l?QbpdE0${vEYclo@FgC-1j_P&(D zIcz`$QRO}NhYQZ{k1=ZbuLl2kTUNAG;aRNa=^k#BHlB(jcBp?gb`x(KR0WExqc@_b>{CaG3r{Ym6iv9V=EV^T5gE1<)lr0Srm#yra=qfuNe5t8(370Zh|bh`Nvl z5CqjYt>eAJbqx}yz7xQRRB6X*O$h{@9WHQC1_Eo`8Be_9g@~9YEO`Ec9{hHla_uAN z_J-TV6Qj+6zYnyWLMLs3AYJDLgA-zSDOrtwIwg^#XKQ@Khfm-=1>`$N++!lNfp>H$ zIvfa^{cK@xO6b3m5o2trk1SIe4{djR=hZ65ZTpxRsKA4X`q5|^zyp*r04s|~^g2_W|`GV)(5an_Xb4b=mb~BjGNg{Ic#25;l2W#q&>>12pwNB$) z$k7`<=_QukK$YF!Q>O1cmksJRAqasWoaOJ*BbP{{xOUJeA48Z*Y2A989S~Q1BD>Mo z%V0L_I~qn81%}BY4;7d(i_5Mn*b642>9cQVZ=URLd``+uQSRJemEd)`B-jn(2`qZ_ z%9>GO>Q4?)5Dmx%mi_qE;119X`+Q1uu*qyMr-u@S*cN!vO&HQx10Vl0#!ExUlEz71 z0v8i&6*z(MW7LN9Vc4KZZhzeltPEbI>{a`qgTHo6q0wvx zL=vu*OY_mR67G4r>ai^QYEYLWV%*I1^p zUvlh1h#c)SQ7)ps&^LCy(Bs(`)x{MH^1=fXzf5`Nhbr5=as`mosc1e*+g~H5$B_H zII82;@FzpB&i&44ZVp555V>c|1e_WGtC^#?ZqzUk(wwy8) z9(6?*VoPobw?EDk3NWliTfaY{fPd|7`3X7|SrBV4M+m?}PnKp0rv?OSO?}DJf+DF^ zPn<}L?$xb#$a)$(1}Ls5Vf`vAULJ>60j2fp@cGr(W{&soj72Vto@4sIHYSCOef=?1 zEa|2x&-9V(c}AcVW7zY>jow3seWLPx?m>R&wd(auhUp*!+rj&7vtd!9oIt7&2SFgQ3~Lhcj>F>1w;zVC_}65V2G<>U*A%HRVh_r3yN6#JYtN<>d&zPA zCH6mO%#{aWGS+unmE3T(kPlHXysK|f14bR}Rq&31go$<%xu0ns2xckDkcTq}dmf!Z zAtFP|hr)3%$o_*uq6qTMUawKUI57F!_YcR3Y2{GBz{Uypez>N!}^{yNAWE#hHX$&_Ci3>D&hSb>Pa(!@9Jr}kqTF{ln$FPR+CsQ~0rd7sp@1clXK-!#Xcsc?t0`DT-7%($g-zq6g z;4dfAzO4I;=A2bEWh+{Xta2%9vBdXj%^9C}wUQoB51o>Qr9u(yZ)#-m8L~N#K$Z2- z;S54@{W4nyv+5Budtv0JnWrF3Xqh_<(0J3(crW>6#ZRn{2RnCAA%09ftHPgl8HQ{y($+Hbk*D;8E^K^Npfl@bRJC~>Jf34v z-a7K$Rc~W}>(KxZwk+qqOy903@S6g#ZqRVBmXa9V-}r4Hp#3ZSdsuWp(xAlw!&?OD zcxlJg7Sp?1$}J6j#<8cx`~d{m&=)#1j$rw| zSdWW3@~eNetA$w-GwHJZ^|3=N4829y`{~mqmgqGj^6bt2(AD{9A3VpaXQS#bq)RwM z8XiVy4h8DfpER-koKBwF0rQ0A(6)ONIIdFN;Qp3wyvqakR6)KoQQr=zZP+Gj2I)eF ziJ5-e!8dQ^uBDJQ&h-BhSFhk>U(k-VMf^eMd0tg<9Q!qk?9MCqSK2Efm)$iCcd_Bb z@{;%ikC_$4(aIn?Ttwvv9<^SmX6>&}9p=MY0o=>UxCd?yIVzStF{mdYY45yt%!oAQ zA_Myc>KEKge20?vhEg_h#bXf3@_`|A(%;oMusE_HW-Eg?n<4wdYOwO~19-dE(l z>kLLLe3`b71*M&4cA1Uo3@UP_iQnOMFNO`FsR{Re%w*o^u=k^QEnAB8M+r}F{>9E| z@^?B@qJIsSpgXjFUux+NqqRzg0$%j;F-#CQu zy&>3`4d<~VDGWAF+I0Vccugbd!YMT2$CL0f?BXxn^-;o~+_t2FnB1nn-KT;7B5XsB zmGlhg!4FN00~`=qo%L;O9Wf|!F!76C`1ST;{8B3&E}0sb!$JFFPMF%NZw}BjIZY_k z76)kBlO2g!69wlYxL-Ex3WJwPejzn~)c~3>`}y>4tDAj}Y!7-f9;F8n5*I81n%*R8 z{}!4iv&n4h{YfjuCy(|ncX_E)8?hI7y{!dk`uym=XeE%;MtVTHgZVqn@8)Kcz)XqZ z@MTnDVESWE&=>w8+8<%j)sr&-O&{v>1|wZpi^E)y6p0TK=KLZlaL- zF#Np;snAOgcBSL3m9R|?39#|mS;IVG7@!Hi?p9c;bD(z%X{0Ds^;G^EF_XYJNBTxArK(-m|po z?jm}x(*K4XeqClu|9V$Wb?|KmYdN6l>-EXt9vtf@E6c}j05-m4D&+YX>ATGEFlD_2 zW{F1Ey;7L&fCQcpnYB&{b(6fp!k$G)!kqxmYZ2qwrjvjsk@3IX>t02B_cDIkF^{g2 z|BNZ&-)u;azHdv;c(iCb4-rztLn|IUeKtw5=Jrq~fshLJG3jKNg*SmnDDAhSQpA91 zV}DVwGEM05H*^W7mud5vk=oz-iMh^9#jX7KJ3ivU1Zu>7FF0{Q@Y=HFG8O zh0XTw$Q3;@v|h!uSpsjEbARbv;b;wK-w^ZDY{Ipi_E6xFOSXV-pKd@ z14e56j$mhd&VWps9|R$*T&IJ#9Bhu6eXQhr+9&dHibP>vvRlPumrUkQ2Sf3wY|_F` zCONqi!bhs@(pO($hnc=)ZORillPLHqV|lW5!9)tfs3XX3o9|}+mA_IyWf08r9$wC@ zbj;`|)F6IQx8zfxD+>2t6n07EM9M7K=CYAbhZnf8rvlbe-na1u$k6}beIiI_8@d_z zdC#AG1~RGEr^_L#F?ZHDs}KtHUe01VeTxiSDg5g`lirY2lcEn@^5Cw_nY@D{UcTAd zRmxSNmoK5jZLAks=3rAFUER2)c*GDW)$*)iXZ3#~f=?iR{f=H1J10ep6o97HV~1GB z-!wlqNCy}^uvFoVrsmb-1ng2hN2#qOYXgA;B;?4a<(yR~7%}O^?_Afi3jE|Gz3U<=vvHbNCwJ&DOTMrMl7YpC-M3=5?C3`^kG> zBQ{Jb*bcZm`{)w~dAFX@s-hktDwtFA-3qX~nST%zjAFlA--^Aagd2_bdPmU1c@j;< z;14HTRty6tc}dR${_Zt!kcKqRAB+WmJ7RQo5j&Fa95{0E7uW|}Nfd-7lVaC;)Yksd zZ9b!aIa7&`5v^%CaVz53#%^uOlJBcLLmB^2$#wOHEviWfNjaK7LG~R-_%sf5y2l9DRD|q3*f$@E9A~O|-6_%O?MHPX_op>3pAyAdMg9G5kMqLj{s1zAu06vQ zjo~pBvmNyq+>qJKibu14ET*8h$Z6Pk3Gy5h7lC&N)@8Y@ir7=IVfH1 zNs6+6M0D2^VlPbXj0yUf#q%u~WXWXitt)E(BWtXl`~2YydmK3Ff~B~q;N4R>1?>m2 zNA)JWw*s*i;?F^oD=YR>a^SXzrwou^=8^qBlCZn-Z)vnzvsc_m~zB@GJvw{r6`m*kJeG&jxeGCP;EBOz$6N8p!z4kZRbnK>ER zztb~TDhBt39oOhm_3x8}fa<_Trli2QistmO4y z)1V6WKaAsJd$L@#ONQjS`+@d81PU9%3&<-f+8>p`{0*8{=?bT;y48xLGRW<+7&6RI zAAwMm5AuZRsR^}3g^FA6?@&3~^N0NJ8t}{`*o*gvE(y+knKWWca-r<6iK(P+n#WpvI1)ulu@R9QTXi-TnO=`;WBy zRZ&}U`ga0zVK~TUQ=100VP3yMBm+@s(|SZ$thMH(`vRXMd%7Kto2WU<8445L*Y`E7 z*5*UHlvtO)C-kypyjmPtqxZVN_}WpzrH+lT%^v`8eaY5zyl$kr=}1`s$9dLV)_klq zV`6-b`O4I)*ft~k9ic~60?gvDHe%SZb zZsT(h2cHJDhL8qzl<7^7Uhj^?DALD;v7kwP9gYFLdo?c`z>vMVz@B;Be4u0=-^1-J zJyw@NcdlF`eI8;3W;hGXKgBeGtT<*c`kk0k4xW9^NP1RudNSZq3H; z6KxDM1j`7T?d4x8Moqs>I^&4!e`{J54;YjKq5bCvenjiM?Bm5oVJlF#P5-tUHL66j z|M>0?Ap$&FIc8WrJvoA#CPXFUN{SUl5zPaFakKAq=OGolU)>{=8qIX5f*H)0s2ir4KIw#$k&PU_7`kxN8}RlVZyD1_gGJx^qna#m67 z{k7G3)90l^yZy1f{o5^gd^Lij?+rjMbFFu`xS#s`g+Yc4`Au#fYq&epF^Sr>Grq6r zK+dFu!S!ildRo5QcVz{HR{j_2qFA(|q-?!EA%Xv`sW=z8!{y7cY1i_#RG0MYR9cC{RZCLJl@;mJQJj;BOOqc*hIM8LbfA0!oP7&lLI2^ z^jFWFTgi~u2WuOO@KtwB9rB1s&w<^yVH#3U#B?r=5WdlqD9UhMDan+1$R)u=hMWJs zBf=kE+NQO{w7k`vRKR*<6;aT2x@$+g)Jpim(DVIf_>wS1(g+@;z~Hn+8S=${n&*@Y zZ(7&K1<-@-K*LNrNqg%%ACA}&Arc`$3Lex7ddwl&T;x(AlAHW2gm=Gl<=!8W^nZTP z-6cX4WDp>8{7oId7fo9L)82Q~fA{Ok9%>5Kzqk~Js;SxdDsYBbc8$7(nh_6Z_CArj zCB>lLhCA#i9RJDv^ds*h<}}1Xn}ZsxFamIAWbW0Gnz%yUW)MM-a^j|SYw`GCEJCp= zkt9doXF&l-Gv4@#b>Upw&FwRx=9&9IG-uyaaEM?BC}f(BDp)Noyp+H~b5WHI1QwoS z?A3=6q_Jo>EHKn6MYIi{QsSTbSWI2{fzu-n>L?mwx_z>{)B^C*$i?4{Fwd+LpdcM@ zmH7TP_)}CyLZ*;9tA}{h2ZR*OqckX1RMnYRgpIGQCG+-6iTCy1R9C2LpFed=c%0?4 z_)I|A#}N))-8;682;H$}Sv=53g*CUNJVJSiTQ6@8FQX+SoNK=3{_2i0r;+~tB!^A6 zu(DKyk77<93AL=;9ruB|_gWQ)l#&{Pgxneq3rvlP4j%scI7V3WGa1(Qq$AA$+l6aH zrBE3bw>@Izl8?;7u9vOI1Oo-#`<`$^o+V@n*`?Obq+@k!agDc79x;yEIf>5m+0Arg z`#%Me0k}O;idoE`ms*WL)Q@vl&bFp6MI%ZYE~!mPBt0vW5Ney9c)N?NbFs#xDtTcl z3(m%K>yDx3ty$wdr}Zxbhn}^EX|JO0EnRDU07t7943%|aHFTI2`3_}_&gu)cVDCpz8VY-z8{hR4)rP$^ zTZj-Kt$~MOC2j60Ys*gh!XSQ}hWRoP(xi#4KiT6qku~#X%VsB*<|m&;_Ydi%OOZY zXBAuVlvlJHExI=*)wpH4JBBx%(+X!<3UxG%3;IE7v~1r+aHr46s@MKI7rXN8Gipl0 zV5-ZG?Q6dyfuUYF*PjihF3Iv2Dph1e5fjj-J@2VGE^~**C8upsp^7$)9uttvt; zxr}Y>b9!52lPHt?A&`Ep`0ja5KBGph&D~$Uj~-lxhLfiD;-SofQvxAj-h7i{!=-1# zj`X!|%4tSNY?FvjzA8hZB(=wA{nYu`8so0lGd7?cCPSCq0ZJops+ymQ&X+c;bcTmm z%&$W z|4ip_dm*bK7^i^9d~*absRPrOY2NgCF-Ts>i6AJ)|1Si9wF zh-VB1$>;oWiOR}mnc7)q8yq*`FI&E&to_@oeLJDbYWVyGtC)m0eGT2&2M?~ASGdtG z1UtxzQ9`TuV?Uj7-tzDy87oJvndqu)0WEUYJ6GHIM9lExV28Gn^FzVg>Y$IOCL)Fw z%}+xgO|b~J_2idbT!|ajTVZ#btAK_ww;3$M1b1IV4;5>360_2%A0p)aIWJ0JE5}M= zh9;$wzZkcb;;kF#29E^4ATAfe^nkkC>pEBNzT7hb20ftz1-jRmK7;>w9I2 zuEuY!yqo3)i;WW}bc$RR+y0xfzG~O42{AUgx?0##;;CI|c-b^}jBj{Yg1i)4C8~An zm}{N%cu+ez6H*ydPEfH$T6sPAw6OCE z!O|O*CG2`MryFRMb$E7*d`(}n17*LQRw#2kgMAqi zv9Z_J|3@~}(Ui2?qFeZ1V_-b!;qDH>S*cmD#Qv^2GyZ&CIy~{N z`X`BC3QJ9<17Q8_91!%mB$ZL{@`7*mWKdHrqV85?V=zgikScwkJ~0c|^r?B7H!17v zL@?NaJI!E3GeUz)$C&Jw>nnX5Ho^Zx*LnW4;ecD*Rx?IXGq#qZR_&cuQBrNK+M}oy zdxjWAN>Oc%+MC*=Hc8Z~O;KCyO^lck?(fBYdGBBGob!3k`JUmq3AxGPgkI zH&=RvIp%&uD}OS1_AaO2cVptghL`s`Uc;fHj4O_&IjpbDcl|+A`~BXs?x|qSfv2?t zd5`%jL$qpznFh%wEc$AM>nlp0l{1?p*V2{i%!gLwS4#(>2bE0%b@9i??@%AU{2J{6 zD4EQPH?;I-#MGV`dymw4<+iCW#Qjs;;;tr%7f$Ce3e;-R44A%eBrp6z;!-g>S;6H% z!4VU0SO|Ul15VXFP!P04C#r^qrWe{{bC+DKE{?u`u zQU7_-TFK-DJ6ZooSUby6UL_II-9;7Z))A3xl)Q-1tL+;&kB)j#*KaF8JuN@aNoSP4 z2wn?ZicVHFAK}Za`aK{vR7efZ>eLy(+4+gJujmfhH3+&FQSXidGuj2 zJQ;BK(!iLo!;Rio>b8vdv^5WoTaHW~9Ep=L`EIiTD+;U{S?VrZYvT8sSwfX9`Y*%q(d#&7gUNJhkGi1j4PwYlS6M6&j7j&0Rtd~${1=v-N)O_6Mx zmEw`GT~9rB`x)aO|4;jGot+bsIpgF`7sSX#>?+Kue3&|QpkC>+x<5@mr65o5)l!HQ zmAATPj1z>U(*#(H#U;Z63)24nch_VgKx(CH0ud?n`z7|7h~%ZsX@%;?@l1<=nQU(9 z@Z>%j=Am1o?t$RL4bzc>?g4O{ko%kRUg5`YAP`xSoZp-_4I2!ofh&JHWhSs)Pn*w# z!kJ}Qg2Fp&GPzyy3;LmYusZm&Hx9K#Kp!J5v>}!ThP{mut z^&h55d`A13DIaj}=|zJ7UA>P4Gu?TLuq8!KLm znmSWYFeBG;|H4o0B6_om{RxqUn@U6bm}jyveBR$Y zkL0pTRHSR3waiqy4!HF>t_wsXMbVsd39!P=4T zT(K|EC+zK^YUBqkeIFc1yk8GUskY>?-FUa_ABAnSW@@w<#p7+jH{OMEYsQ2|u8%@e zbt%uy&cQ{WK0DWl*Tir#1b;R(8C8@Kr?TnEc)0Mgg+XLWHrRcQE-@Ktbam!Y2M~eK z^ft9Wh>_=?9iplY6SvTRJ@Qc*lBnT<>Mu9>5%+gM=QX#{xvh@Y+JI@rf)D1{vz5`v zDDS3??}X8)h5tfjMHLWK_*~7js4X>*r?(Ft1VT+N3A& z1B(2Oj%U~8`wHPFyw^+ECq{vj=Ojs1bRtRHo6U6|6e5Sz$E^ljk;(j**Gvc{ve5KF zOYAbc(XO=WWXBhZfVlx+O$9vpC4I-jW|a+7Op^|lCCaAf6ruVZBW%s&$a%?n|Gf=Z zrw&pSmH@wfF}q+In;dY+?osa1JMdOq5&HhPONZ%wwAo{h8p=Sxl0)YklPG^gXji0m z#pkmxtT3W&^g)rN%k7Jbw|L^dxNE(NZma0`my*k)il&K?G>J^Fi)S{XMj|1;vChB# z6V~8_;iC>%oZ+7K+FkZ#oFS(+^zV!h=Xv#&Y<@w3$Owvme=?%KtJTP5@4tf2IgoH1-^>nIZdbv%o z#zFVgkf%cO_rbWssd2?umqB3Br2c0w^$m%xq*RmlghqSwMd5~Xe8aus7d2lU^P!5j zuGUOJYl);#ml_?Ht^AB$YLjQ9q2R?_j~PeTJ8BxZZL(OXZbjR%Nsnzued(%_QD}RB z1#cP?g2m2Vx#3|L=CQeesf()7t@f0@D)ae%raeVb+}M^u#%RJ6pUKshMS7yFd@VyC zF7dMu%=($^zH@5pT8(X1smjWto{52_bH8&siP5#~w=tXJb5;C9ZF|bTfe1*A(2Md;4_nbAk1pIV^>;bDKa|+?h#AV;u*>A83Q_rcW37u66Wz)c zy&1}9BFkxC5aKDEQkZdUF@~(?ejwKXYeR+hj1uIojQ}b1;H%ZBEt6>6l&Vg0jb!nZ znj!6x3Nkb+v4Zhw7e)e|GVaW25cHF_?>2{V47cvaqpNvVugQ ze0nZ39Dfj$D_X8}iQ2$A>h|Y4Dk~+%4c636UAA!%{udUiM0_aqvMci4t8C@EKcl&5 z?|^5oJrQLUl~bRI+?eot?ViSC+m?Sq)#d<-r9EWSd!SZ0e?F}bkL6{6ebD`r*9U*W z2sm1$RqOuOEmY#=OW*(W#`V0q4{jgdQ8F@p2j=gcig~!Hs@AQ57wfvcfTsaPMKIVD!V` zGzxmHO8w2y*B{|{FLoRp?!9rJ{(^WcrZm^DTo5$3)^xKPD9yWTOcN+z{=7R>EQ=HN zmHwDB?%ctgl~?c{(ykB);@_%RjGkkm`{a1lF`DHHx(QS^xgKBwQLiaWw3;!~^HGNY z(9$3fu6;u}{xRHS)J;;;SiM`q)o^#o5VY^~a_0wq^p=v-JE?DX8#s*(F7wpyQ@O-r zNGqTlI&?Scnlx~t>>HiLyzO$4oCt5L&FB3sLh-iY?}tNM>Y)w3mTm}mY06p1emMbe z=#*lE$PGI$^W+mFDiu)SK`kjocF|b1MV)-|t5jKJOJgz*Zx)yy61oxhg1Pv&|F03A zul>(7b=TV9X_I>a*VC*Zg?|zk1Jz9QvLkw`FC*kz@7J%?(H}4AC5~rH^$O^D zwL=X%t{X{`I5t)6HvyU=`>5wWDZrh~0mi34dxDQ|Bg=h=I zrgzO1>V2B-K=yZ0V}0Iy^yK;k3y$u%@>>N)l9-nnxxnbhx?2i9aN*nITlHATXwZCx z44>#=uoh%eQ1dJQz( z%F#?nCso$4wg6~s@dp4rDBqXMu# z)=i6_wBYS~qvf;SM5!QA3;5-wM*M!&ld&}>%;A9)s=lFGg{dK|zDtTq(VzQuPYaa+ zkdY8l);za30biFwS@BXR$+Y<=SA zbq2El%Y|7ZM@SdzbVz_7+T85<2m+{sgZ@jfQqhaj0QY1fx%fBjt4<|}TSmgGX z6`1c!vKz{UTT*&*t*U3k2n|qCgKrMe7~$cS8LL7V`8B57??CRORw zUNGcYiT96y2adf+0`xl@CksHZ5opz8%t3$5ItzH0)F~c%AgRT6Saa>cMWaIrmEFCmNr!?Jx6ZY@kfkZS+My z_v&AjXMh-suy4WWlJ{5ik1BL4_Y&x~Zw0gl`W*Rg_9eufIJOIr@1Y`uI6_g(e~PE2aZ5bs@Xmhz$=(B^06p zFCZ@oAmu`zy6Kl)_Am97h_`#H_PwWxL%Wt2=C)OyE=e+HjzgA6HQ3N_d}iRDO8tW8k5`ldEoM(f zLb;NpWBAc~_rri4p;IeDfHR*1J{lr)B8;VK{5wI2>Nr-okv+-%1NAX^7vjC(3_6wY z8aQp6dE7&kw6JcLQx}fRS`_##NVcW?@{9ZeAoTXa;nGcJhS5l)skrbM73wwJhiRbY zy*0w86^R0xjp&U8qWSXQ6x0VQPKNY;#)NTg_f3G81Ey&V|`*N7F zw9i&cl{V=5hun9lK8MGtcyivqgZ zb6@cKlkN3?;^&U@X)7&bW_b{0`kj|WT~55)^Vs#-i2GxE`xh~zRD_m`=M}vI8migp z`wMVpLd&ejs{W25I_@&#Y0$#Buc;w*CNDfj@_G!?MYp#{wkgFP1z2iNKQF{R;SHiu zFikP(RPk8pbD$tL@@{4jiS5Hm;DPVQvDhkkJIaD*3^Njz|8ESFy!dgt;aZ>(*?{6xEc=Nob zI%Lrl!u*IFf#q|nX$M>@srbGHT*qs(4<$q(zW)=ruzKRFL~-#=6T)ABtXdFx9|9Z zd%*!)_H9TRPUwk{?zA#QPH3-Y)@Ye0vhr|kLlMp|-RhErWJ`K1uPFLJJ&~LlJfIg5 z8t_u)6ZB&{d!ou%AZCZp9{0HV|ns)y! zr;biTARoK9pzCsq^9+|4+iMkohO97_kkA$R8RIgBDvKb3iy|k>HPg5#d=Wx>;f8Tr zK!qp&36;;Xa-4x5H3-1r#>n$^pVmN@d8SKDiHo=WJ{evYw`)pvnnQi}$9sSoQ4iYL z8Cupo74PaPGqDCg1~G1_X+2qa+m`LJe(H+AWK6vPwuX$E74VK>|dw0`78;3;t<1 zvmU~qH`!>r`GeNTOE@pC6>~k;f}gK5s*X2*efPPANs0}r@akq-lz#jlha%cN97j8p zBWvOM5m&Hq=*pqBR`M`P@|4r*rr8o%{fn1vE1f}948=G1(JySx9GLIcRhOPxOfOp6 zQDruBbf=tMzTer6_2^2Xf0?PT1wHf3`6x5i{O}^Q;K)W=jA!OjNtz_TR#x{pH5-e+ z!1F}8yyH{CzQedO?sxrWZlCH2>5NsaC=#Fj%E5I@0jxZBkY>CI6<5h6yAVN#$tw|SG0%P&U3H&zvpQ7jZ z(iT&Gyb;+_)^EDXSG_W(SJXq#z9jtFhdWGK)_ICiUE?y2g4vgkEcs-{La6f3NY3S5 z^a?!j#3FJ*5=s!IM*T|lUpR<#HPwr}<3TR3m~A1t14xn9bHR0qUt-{Qz-MbXHbo=M zZ}UHU5|F>i+<+81!6+d(GtBS&K?BS9+?n$02FGzZ^ry>@<&jPtkcw9+H}}VdIYlkT zMbpfBpKaNdj5YgN?(m#C!vB?431HE8qxSPZ1_58l@?{!=y)aCmU+Nb*qmBb~mFm)% zF*3q<$RcmB9gT+!rV;x{nRN4HWfk>YWZ6D-$4`n_I@F|Yyla6dK4*nR-k97w`Bf>7 zFX^Mx?A|T7C@Qa7iccax>`jzN!cNvV54=E&3(4*RkK^Gv(_m8a-`oJ{80)g<~sg7 zw0JtAx#rln?)3Tz=ELK=X*#Cs4}5Apfs^o}v0$-A2|V38^%f(VPvZS!D0UT0j920VHGex1#>y^IxV(J0ZHL zCRPfbN|u~(fD0EC$UV0?dlX(hu|0Z3D3C}W|7YvT!@bW=#7~(dVe%_@J)ziZE;Wnd zLu9tP)jwOLK9_v7(4IuMFSF_nf zbhS?>)B#GQV#@nY?W66VAL3!tr$&CQ>s80M`GY4cf?El_868CEqG#C(h__G>$K)x85VZHK)EWixfbT?-Z zx(z8wX}!-HFNI0kKzNgkB>HUkR`a|IoLU@WS{}TZ$-CfEfuDOGPJGx{gr^wtIH^t& zUML$O%WSXs#6( zcv{w-5W;o(eIZF}jl)LwS{ODihy1q2IjWc|>+&=^@!eRniR@LX;AKklS~z8!;22oL z!^@olYjJm)oVsjg#RwBk9OQmiH<&!yEm_L9`t8z#BR|CKF9Njn{8tMnJ`Rx!>|y^r z8rQCdwqV&BRnLln-r6gqm1(cWQc-N>?H_f($HTteSp zpBJv(TOL7q-l}xRJ4%?>r``r5+d=gZd1NIPUIs8?7r1p zj28lTpz@9ntRnX74*BLT!<{%q71)qAi}-!vqpQ@6&1u%7$dcmEuaj$118|zg2TgC4*Eb>BSV}*ZNNTRXEZ-54yAh2{?E~bQu(tZ+-4sjR= zlp?~ta4G+pbHAH3QgL(O28DZHLQ>v^in)G%`(oR!*nwcnKxq4ot`u18KWAHSKkIl@ zQq(e(p6Qo1pLK=S%#|WljXHqZ9EMCbsk=QXQ2-!fzrH}J&)K!{7>|Jw{}jnl#-YYI zX6GoiTev*>a!>Bm90?=AiV4&eZJ|QoLa? zKb2G5wQLTj*57aWNsow0oqEP7vpN1+aor){ICHg<4k8UO8v0tkKyf*P_|Do&durts z&oM%RW))Dt-~~zXDjLE8T~wos`=-jKL}y=8-cDMBAIg_^Ngr`w6(A<*tO0Y_x=a;P zmFE42?#zS;C?Q4I^a6) zQ=rxOv!kMJ)n{J0#ueXUH}03-UC=z00?z2p4hoI@3jC?v=pC=ZJFvWE})#G#TW)W{mHON4kzmqf9bYQt}t<-VS}3{_ye1H zLL@spkL7$scGIEThIC9zY7;#T2)`}(7r~G=XdhM^+((A}6nw!{B_mz6`#3+nf#rNp z77eNCT55nKdT4SmRr#}}I8kY4{wkk;LlU&uc_Pf>b4amuZW~ALwBTCW^RvPvQ)RCzyKudHsjPUa+qEdj#p}%gTUDZH^m-`L}JS51_KiL2wfK zUwKvs{-F?3wCfOBwz276eDJ5u#6z<%d3=z4lr{2BgZ&RIl;Nmm)Bbx1UAz@!B{&2^ z8PGGI2a}+Q&*9!|N90ELF0QwJ{605!`R8zI`ac^Ys#prmAwi(t@=BQyD;(qEbXp0w z&j%yAc!`L@PS-6Ok59rfYQ=MAZAMi~-h`yEVwdx&pz}#5iM(Z~Q|76#QmAy* zSDh|kB}taH&pw3$jqmZ~;;_Annxn{-+^~RIS=AA;WjaIv3&Dc4Q198+m+AHSN?MS)a+MMa~>M?dL_}~~c zbLw~>0k0$m7CiVnsBDc4Fb2PK38uL9GlI794dJzBxUOuD5{1l!tZ=`B?{6yq<9*?@ zaH8GJ%6Vc)q3FTGa(-%%%Fcjhv%c#eIC<1Ye!H%+@k1uo$xqL-&21$(KF{^B|B(XQ z?cFWj_5a#B`QHJQ9IgF09nI?@vy=aK6(#QOg5E%HLxcY<8~xeF$@G^oBhb{9=jCi_ z4xCM8^V)P>H2?biy385CQ+A!VWnnr5cWx3K&2x<|J--mn<_tPV9&eW2=sqO|$>f&E zy)#(3R&2|+70!>Is(sl$pHNy=Vf@iSneL2sKJlW=1s){$WJJPKBwv{0gFaCA`P-H8 zi2)#*XE*u2mD_{}yzC%bTNTP^kV6Cgo?fXjNq&f_>uaH(;!FDCvBsY-IM^|;!ln6^ z97;FecmdyioNd4UOntI7NaEC$D1SHh(B0&N+FNakH%U>trQXk63~d6qd_&p!Wioqt zb`L5y<=2|Hfzx{C-`N?O5n3Bjx@zGpMGoXCqtISgG#1NeTQc8=StXV}PiHnF%Z8^H`n*O( zQeFGs9EQj0fHpW0u(VJj0}6v^W515DAYWn{;Ebl~%f#u^XFO#+uU%n779c}&+|11> zU4B_?W_`T9=H!=VZmPJoFMXt4A;D&JhL5fp8##!4vw1JP)sc@G<{HjBgDH}5_baY) zt661~%Yx|)6U^ExTJ9TU2r&kj7}1}7HIC_fNs&Jwc+X^)O(i8?FYk|Goi8l5kSRS#{|r2-rtkU;l`5VJ%W zspe*Urj|;6?=!8K8n^rrz4EEq$O3p!jZoY4gX>x$xSIxGv+}A&b@%8gip4@*=}10b zurS-2F-l1~GYbJGT*998`UTv|-epFP%U9De^|_&j)51!L?&HQ6J=`p@KeI|BOC12; z*_68J4Q-PJ@(DZwyqku1YNx}f1gBrQp*rTjCj8pc1T89WyBiQ*VeEn(gV;CykC#SI zBE7;>vl^+63c$V=pJ;EK+wb!c1&nP;-!@j!BGI;@W5?m` zjjrC`uM+HxJ@NcN#1c)IVIQ#a8NQFLpps0jd!kk<|R`99U2l^2(jk9?V0a&&SYRpI& zvl`AE38S0J*uf6_dmMyNrDB5pTjc8*AD#s2g zSQPFd%9$+DPKE6{t^PNDL$NIW0~g=>WT;vPlYk>w&aewenkF+4e~B%c>(}69d$v*? zOm{YQkK9UmsK2I5D1vIq&gXBl+8e4RWJxDvkZ3zjmrW{?`e^x!!9GG7q`V0A8RSEC zMk$(p{-=#vBjSpU62`7H4g1vx$ZZXGHMEVXPGkrV;=_m=GIUh+2@ao8;DPfi7xfqW zTcMPicL}def40I0oLFZXSUd_n7%uWCHxDx*5LHs|_-sz;1=@DzTdCrQ#6g~Fo*xy^ zG^dJX!c){Y9p`=AMJ!ltk?S!g_q3A3H=!#K6w5G&Y?OHYSc&nlY^%IliN>%1E%4c- zPrT~0;SD(3u^Cj04ts}qF4W0(#Cy0V%!i=35cfQm=xlLTJ!)@>g0tP}{F(;@JlDT| ztvDJ{YIGejJ(HJ{Fg<;dMWi}@n_V6B;ApiN@382{HZrja22@wm{MdkSSjQJZw~4E$(!eVF`sYWA zF|$pJg8R!c237-&&RtN`Zz;Cv^izM4{5l)~e&YwR2~~7QS-rRBOxMEwKlk^uXtsg^ zn~a(Hc7MK@*eV-?fp;?6(BWLl?+^{F0B9q=-gE20win6Zc%t6e=yrwsc-&Mj@`IM& z!|+=&kTl@n<28pfB1T>l-DR{(Di&6?;3?u_h#-_(O=yuhpq*Bf|K$hb-aQlbI`z*B zwVQ}D637*Ly^;YUI?{3Txvej}H^e9Ac}#ctCbtG#PN{e_k*c4F=?nqen_7{g7JmJQ z?K@csAwk~`m4FFgrs|C<%O$Nj7h(fpT=NExO3>lrd+E%9T#*XvC1xkj1PIY=FSiXt`c;B2D*VY zg?KM57is3lC=gCQiWa$Oi>OLN@46lKgR-RN++jN5P1Av0Eqr!1`dOlWET|ZtpoTiJ zPD}1mmH)KtrNd^X*@!UZ>GBgu8d1pm^Qz7$2O^+loqI58YhShBaK9ZezphNzPLb@k z+|1dKW;4CIc{Y})`8>BwwJ0Ta^^udw}ackMn z)@u#m&GH9X<|(Qmwwlpb6P)MCF?pl@MFG}5ZIodjy|)lauj%`E7XX( zYOC<=_2Nb@J^c12OjkU}dPuSzy~a`fd!FqN-+I|cIxMcN`HWCkW~?ZG)%(8^yi21Z zv!y3IsP3GIlW++%494jlMhEf!8PE>%zZ>2G@7Dk?ugv^`;>341NxSXDo8C4Vy1rmK)JF{1RN3Xo=+!7W&NQez4%vQW2f3Dv5o&sh+L|`mwUce}l z%dR6zGHM3ct%~CI*~&s_Ky2(9X$s{s$@5TmKZ8 z&cNj(`eM+AW5g!z1?7x4=XFGgb|bNcl!fD4Z!&z1!Cs3$>v_^3N1h$^y7r-WFH zuY2UhOTCvdT}qg9*n2><^1zwPKCjfIO^Jr<4q>Rma2i+PhWg#_*6iv?RjW?2w@bt- zZhi|@_)+7KxxMSgPOd!qsp|^nb5k?Dp0m_3t5J(3nov~C`Uju}%MnJ0;Z~byAMGTb zPkk1-q_n$d{1N|BlKTyq6q*IWMBEk()?l{N{JB1ch>X8}%|q)WT=NTJL*(J1yIJQZ zcXT#4@#8PgHhJ}#W>lC{TJ=5g;KxTQ)=@NxG2X*y{ZU|q!iD|eF`jZu2^})?p3(<3 z(f9q)1ignuJ*16eKXn(wCiPFb_d$t3q>}ywS5rTK6z8T$xl8bbkO+8D*dB(qgypH ziJKsB(eG#sNhxP2Y~TD6k5PQty-4A+mG>*zLw@}N`qJkV*@9c-ljbBbN3NT`=^?aQ zuzQ1@wFaE8Vt(8wR7Utl@Icsh?=2b*Shvz*s$E(PDX+Pwzr1-ugAQpV)td29GZx*H z1x2Rk0whyD1X}~X@%%f`j=uU-gXDYi8P$%=IE83fbqTky*b?9Fs$VDt~u6vS@JAjMHuV2DuoX06}^fsziI$?v&8@4~$+_jshKMiEI9g z`_K87KW-1@@Ywp<@#mN*U~3`BuZ#WM`Nv09i6(U*$UWsjc2sMG!a(vMI8y9o_W@gU zphvAU3ui7*(5!@Qd+_6YAxg zX>QN3xyjBhTb`i1hkN(A-6FP`vejQ&${F0+rb6r5*){&;*;D0LI3di~xm9Dh;{#2i!uVEjz{lCh=VR=>8 zoc0FgoN&wb^S~#E;`zoMDr{+PF@hsZo|HWu&#{lhcXztk;n}L`nTJDUXQ5eH7)VTz zFNb|l1KpzK5caxB6K*LKSo5;!!3pN4JiGYE?a>+hzx8Xn#ni1#WueSBsb`Px76Hv% zMpB`ypSHyff2DRUp{|B;q~}$Jlr`N?bQs=tik3MU6#SwFOV?mGGM?3j;mT+DMjZ$V&3 zK6$iU{I;7wCwXxmxbZzUl8_Xht**aXIuo_s0=lB?X@lRYn7E$)W&xqmJ=S6bA(?P? z#rKdfK@Wiua)8EN&@KetFv_iPMpNEy^E6+TK@2NTj>Ksl?;AHKZjTrgxi`IlX9q=K zKIgLK3wdq#5Z7O< z2v#qG@fe2>E>l>+@(iB`tU7)v zlne7^w!+X#5?k_)cs)qX|D;JgU=H4=S9X{Pj~XS|#I7gjzhfP0dZmz~2^gx^uWu9Q(Hl^C3hWa^`xC$d_X(LXtsO-nz;!Ugp+UFpIwe?Bp?dQO1Oc*h?D)XF;5hIVtm_Q?QLVdlzK|4^+$5GV;^F-Rm|lr7qn3s_L74=qVU6( zgPP&JIJo=eqj$@u9QiJlnL8|Zv~uk3B5sjNSjS&T@h+$<3^P2h@!Y4r?u%%}69{_y zjo9ci;yUUaml|$$sG!?6N-PdWocc1}L~e^}Rf++_5shh_kF~3bLjCrE?HV6d(26&o z2$bq5Ubbb@ZoyWA>&~UP0=9%?uvD8aFnVO=s^of4Xr4RG_1mrwC1xaNuJ$CAT^IC= z7#X|*ANB%4?tDj+WVMHjdjW@R?@#T>T?Ti@LRF5oec!$dH|ERt$4hiuzT^vHy!yNM zF?G!G-?Ay$*bkEIwQdLsnQBoO`mH03J#-#v7*=qvwtzf=C{fxq9%DtXh22yQk14-HkZFO5VRkx;o`*ZX*oRD&%eOEL z%a~`dvESaynDSjGLz~j-O&4jyPUh=YoCWOk;dXu~#Um~c^GG?ar-_7Oh1nHO68RL* zM}ND@lxCRpXIv2b@D|?@8;fMBHbk|2qc~DSID0}i@8|0xeC|U2FztS=7Wou)qv~pG zbe)*E^KW|HnS8uEyt#_eQow2Tt)S^P-z4&_N`6{3!Hwt4y(HpA%S&PPlT^acQd6;j z&uTeRFFzYu63~ufn=4e}G|B>wmyC-%g!_4zK5ne@(-fCA$9FE&eYZzjfIH%9cNv>=XZTKk zWguI%eJ9QvvVO`RDL((|Gk<1hOp)qN`y%OOzut^^F^1v{?hh{H)L;x=dyml12uH(< z7XQg5Zik4+Mq`&b?poH&7{qw4<5yxCVfqB%?v@R=SUSALLCv7q(S%==Zl`5f0b%yo zk{?Ppye9k$-NF{`;CENE*PnX*s}!?ISo5QhpdgxEB`Dw8sLWBuo2ruEBJ|2{obLWH z9bs_fz0VOQJgt2P>)ez_!z1Qun`RI5GZs9*Cf_6KuuWYA5-O~>WWK)rLOyQcZFMk3 zfDk!`-V+|t^6?h3tM?$6?ku_r)*quCS9Jk2vk(J@zalGpjk$v!;=!`?H^ct!9zVHm z%65u=Ep8ba-#E#^n$MNCznU+396Xpb#?9`qZ7<%7()PQzsf~@Ds3bAB^P+Ycs4;%HN7wW; zfV*`~|K`U%l&NDUPd~~mcdLNNPqeAi(FzwXFWiT^x(K{4r?NW=$J91RI*k%FO}JXb6WTCZIF$e_1+>Kj`qrEMFA|hJ2;M z;&A+kK@OkWwani76zVi@-1?s0@_3(U$J#T1nz-3n2=53{PQ&h8Q`gdID}oov5WvdA zaW+7^$zrl5h`6^!{t9+GMQ*NIo5k5deuL|AD6uNKXK*kaRTMl1+@}}g!1Bu|rK{X) zy)G=X?*eRM595sNc-qnL`5f99E^Cda;~pkDl!CF*#!{0>)7K4uf&Vp!r$YKyB=QSZ z8gB(=#G{oXng1iJP*`P)rE4fpck{c9cA2j($)7AnoYvd97iEzx7(t}iIAfF_4H@{H z5+6zUk~7Zx&vdoRnAPq0<^uYkE?S_xfjRMt%40baDZed7tugzy&SJ#|YOr_#oMqQ3 zkG!|?tYWxqH5ZnYP^^#1$W=!z)um`Y){db1QHogNS8H_ea+?efwU012IL)5$CU6Y< za#!VOLC2d@4%U>2$pxdkXK1%`zTdbPHxk)230-CnD3`CRpvEk2`hX||fy z&E>@Qn`z64k)1Qi9*;lG_8n^yVVOX5g)*4kNi1@nmz`Z0;Dp0~^1fD{Szi*b0!pID zwo^J+BRU2575Vxc^%J`g*b^P6p^xmDd~I(n0CGODlBr6>h*>douW%J1RKAP8P>Muu zJOO!5x+?&LJz^wk{r3v{w}oK$mCeK{XH+}u=QYdE_7O`%fLKEfv?_-ATPOi;8G!f{ zOA@*~uN8T{qxkAhUS)|F<^N==)1PK!u(2KEKTUNRtQo1tc`g8qDw!_~iven+RK$?+ zB!1eH#JF;g&dtxs)HDUD#seH8J1!qtTo(vS*;DhzGwk11clErR{wA2HB&c{Q-)wG*Mhlbl$u)CSJndRC-GtI@l=(_`^y zwp=@k?BcleT-b^g0)`|A6f#Dv$&x@#{wS5Qx~gLb(%A-x)Al41oFTMh^#S@a{o{85 zx23C-{xeboW$sJp5L%x(D~Tqyfd6no3;0mBc1KTxFv?)_S~nX_bID7skn`<+tD|g} zoacpM=#_787w9s9Ug35Zl*=PMKSIL)hqLdDYAOo1lrCLCM0%4hAiak!DAIcuP>M*e z0Ya4`Qbl?%3Md_IchC)UN;2)`KLA2%F-UpQPc@r@WAt+BGs)l;k*X$bvglAk*#m+{9H)K8ipXU zXJABD=US4_x92dqlSK=%u8P5%&QAgxC7;4ueW_<}H??sUScvmX{`M!vV!;%p*E%dt z_zDW|A2r7!Ak#s4HUahFkNG6r5s!%qe0L#PpYMS^nSyryrCmy#0jP8FnZ@P8G){HA-?j;lCb>6gv*k@my(Z4+vDcXCc8GHNYR?580D zG#8@h%ft4u)k7m+B~HO24)xG}eY`t^0m!b8dRX@)z@(M}x9-r$@#IXYAp&-r8L<~# z`DP_?!)f%sfQ(GrxP}T|TK{K))Ia{}^TCTg-_8g)R}Nmgr{6@AeQa6ZTjKgmcE!p- zDj=>*1VCB5lJev{U)Uc!bQF(Qxa2CoJ_$4a{iR@p);fu-CH$N*z(QjuudbCRh>Eju z7vV>_ETTS9t-FNfHf>e2BNUv*o7N1xvty?FbxeCg*h{%J^;Ibnq$XUh89McdyWhp=U4bR<6? zSnOe|l*B#apP>uP;-c}=k~HPna2XMp8vFrD?FZ<>X6;Si7wTbclj?|FBlVuLfd-Tc z#mJpJ%~s`pYu)fbu@o`ao`ma8<_ zZlr&(T7#eumcW$~0TcJrLJAcZ*z?tP zg46wu*+?Fs>0p_w^`B2|8Ey&|yr3lZ(j_ml0~5{=m7L`2!u`${UoW`M(_VZYJ%>G9 zI+;olU--L;aGw+8D2!)*_0;vfKZno#gvqm>doX`>z`vgzdd4|fx-5O1bYT8kjGuA6 zq>ZFB;89u*^q_J#fk60u%<>u)*ZEE!WXTkc+8}A_wph?tF}kNSYDhw7{5;Q`>P~}b z43P6Z&ndpENkA3k|2R!^@!87~TzoZ<`|Dp)e{;^2qS&?3{s}OGcKC587*_I~4DGnb>>heGYn@M%^gLdQq*6 z_Kwk87W6TQB*5@k^HInswiVrV(sMeySH!E|#rj&bWbP&Wl}+gjd-}R8N_*V1U8e0p zI|DW#UgdF`kQCR^4F|a1)4G$FiqmKMB;f2Y;*dluE*eCH84mNZw4^!Z^n6mPsqq$Q zuj(&5+pdGM(l~#>Nv|{#e62#5hSjtsV}Zty$xLWnP<>->d^8zRyL68ec1|b!{T?ES zdvR-A_Cfoy3M!2e`Ryha9ISBKuJtv|ocv}a+vs+c1br>u9#$O@D$cX>m!;T_DuIzB zbRfQ3%7XKk3gIetORk#vVa|^69|wkyLy~mV!McQ8KB3xu7!O@_+gtk*FNPpHe(%gX zq8+*bqfs*Ipfw}K9}1;$WX5%dTgghwJC~OlfsF7GCi$H6-zk+F9nV&hUz)(NQ=%~) za_Rv>{z_k|Kxy3=^tV9fvCDgsi9s}Ua2v~gxTNx1`a5py-1Dz?PhdYzk7WcNv@7)1 z7blV>Y6c|OHNPN2IYw(xNvW)HNlLztm^A-)JTK`83EbhbyTLyf(aUkKS0(xmMrKVH zBb}9c6I|-CQi?=&JwN%QA2??MJ>0Xq`~GLlXb>q zX@jqkWiVxG>soLZpyczA3cXvaq!PZ(6HH0HE79aJUHyoi+D_>Lp^RJ~`LwyWOAm zoMw5;ZGFx20)queI$yZMAv}^BE-xGU^T=W&W7l!`L%}Qc9(`;Vyn-?RCn^#Ku~Sc; z33pL*(b(Z*$z!Qa&1$iZb{0OB=scdWV}&q$xB{$eRnC5XE-Tqids)eDIJNZ- ziq8qY{ovelDh2W3itx^LK_51lz1d-aU}W*z^axyw-y$&n zy;B0j_=#QXz4(#^F@qHKvcTp^fAbCt)m0zkX4cyDmE2DAGAtZEkO+9qkB|)#uyWf% zE9orNiT+v1=Uu@$eC%WcpbboEM(yUjwCuRzbv+*zmABv2lFedw48p3g-;K#mH9Bv< zU-!2@hlOtTPDFf0{16pMP)Xs|3txXgXdUX;k=J=Z0BZ*63F6xwKFtd7h(@1Gs_si! zSKdRZe!r90aLW6Vzd$7T6^e4~wzm`E)J$h1N?Yc*>snnvwHx5FnqW@@uQ|_w)Fq8` z{^~ta>R}ipE&ON{tXXgRRj+lv&HP?ym*mx-*N;Ql|HfTBWDTw3;o%8ZWJ-exUs&D} z+L&MS)r7ob6IfJ~b&^;np4!mBK&*`GFSNP#`8VXZ&tgdQew+D3XPXB`+B)|bk~`Mp zDGa%92EK}twO-9~xPNJ+x*EU}0lxHdc|LH!<#RZifKVgd7+sz0OIJ~n-py~czI`AI z^3>>iM0a4!s^m&_8{#m+bIC!T#-P1Kkc@xgXy*~10W68q-;-ex2{HD9X<&0Z7zI*& zsXQ3&g+d0_g7hMB6E#_shXmnv`A14!Bz}wM9nwGYG>PWqTj#nW&?c5I@)a4Q$*722 z6q@nar0bm|s>IcZrsON~LRlUxS(Zef88Qf@`c=c)4k$wsAQ_`cUbjldXCvk^{YeOjaHGkxnf%Q*N~>A-v>)ypSOupG7b+h%{LN zck|j%N~kgstj_a8D=~EG>p^#^2p%>L2LMYgy0L!$27VLS1v>(_AdK-Sq}e3(ASYyZv_)(tMTj;=OPe;uJt`bt+o_EYhFjTghR+Qg#8d;+D#5mB5k z9~!7@JdKavp;#k~^ms&&u#?Ei$1wa)I1f5j9fDvx9jCT&D`+agQcfEEa$5+Sx5(FI z2vDC*D+qsKrDjlZz9sd;g2mewn*x6I8${^kW%6vxTD+;s-m3BAjsG``ZG$oBa5D%? z?-jQD0Dpx#o&C;fIOe`604c&7KJGbuBdu9$=k%vbu{b59Kl&oUX0%zI>2QAPQ6JAo zUu;Qe6NbA>$+4kjn~Qe`1)D!%7?5p07?}1~p&^s01v{TA-6!&R$B?0E>gsB1q72mb< zo*xYS~r*Mi3>-WqTGUWYHmliK`n{t9|C2yP{z>JkDyAYtLp}Wb1riMg@7*B^MB&7 zyqRTG++Z|DdhQV!GM%giI@*gOea!}rg++1<>K@#}#j%5#mw)RKA>lt3U0;-d6@OXn zl3_Y)yKh;{zH@*-8gF{j{lg@$jpe!aHkX&1ZDhiVwtL<_Ou~i~2Fxt70()@!4g1^^ zw>J5f8iRM^RX#bI)Hm#R)9*wNwU8@k;fhMJovM*W#lL@7sVY!YXouUY-PK(*iC)ki z=;>l`1FO_Q$uv7@KQ-BM{p|~2L+n>J>j1?A-pZ^JbrR8kuCz3Uy6Pdfj?odZx3L>CRgCg#^CoAvDsJ2`LSG z5ME`)9r;pL*vx%??X^&Tw;8^oRCO@I}nLM6^Y+5Ji2JF(P0`_=M;G@014)I?U zp`=2{yz#;;y0=pZ&y4#=zr*yl@2b5i4#RJ@?aRn!~Azb{R)ds>+EuE|l55h{fA zGp52EQji0WJsrc3b(}xHRfkqT1F7lLo%d$OxF(`h*JYIQrU(?mUutq&-^IhKG!4j` z2xq^+%?2#9PD3{ZOnA=BXvrj^`u01iN@|C)7@Rjd7J5b~v^WrAQN$y{VFSL@GwIX~ zLCMBSHyP+JvY4^Dm$a|$ZbH9(I%3<&qPP{Yw?NwT_G-@C8^21-BMME9K?`-@f| z3U_p;=gNQ&lNLc)XRAzg=MrbUwjy_!)}=_wA@FjrqkIm_dDh>UT88@HI|tyq;xHl} z*sQ{NQr(}OzX{KOZ3y2eIJ>u6Gdt8EJWMQaZhU@q1S@TE!3+SH=w4M94s9zwBHJZgA}y^#G}Fx&cPg>FaiLmsm$6Ia*sW#H@Zrdx+pM-wJ$?^)cnh+X zBrCQ7G$80xzwOKFz}e7wd!Op#)}Rry?3-WjBF4$;tXfPSeQoK3`7G(2j%-{Ce^{Yy z;aFFC)@_E*leO9=ZZ`hLXJh{Fz^$dV+4xH_#jSI|0R`nv=*K;r<1$@#HJycUNWx)Z zQMb8-aU7K1bUj6@4_5humrSu2M1A&;&)ERfzFq~5eZ>B_m?0mOdq!N@ZWENUkX6n9 z^s^(tjw#`L=-_2Dk9bO+BLD}nwV8|>o{ITL?+%`Y=&(-e*aSg4cflU-u5TW+G<3I} zpc5gZ0CU*c)Oib2hq~A9+eru4*~$X$_gnvC2r-&+Z+F-TU_Uk*60$TVuU?&gI~$-EdJ>wg-%%;igEESw zJ|pjeg%oQ)oOeDNkK-gY*qQwE9ov(34O&BI^H-0$SgU*?-19s*ThKJkI>RCCz<@zi zop2CnvKI>Lx%7VIpg5ql3a+Kz!bv^$VF`Wk`F$NDLb(e!tH(uj0a%}%{e))9xjDEi zAwabQ+#e-&S&U*Y*6js*QhxbeZ+L{V=E(1g&AaY*QT(Dj|2gvuu!FGZvgPzUfH2!S zFMin4iT0O83t^-PY}u@4g7Avu^*)HkTfLZdvhJiwynMTC+xO|v%8}+-B=xgl_O z4xXs=b0rg`iQlR@_1}ya7yvqo33nzF!to4qs_r+#QG49-+G~ z^{Vq?)~4-t=8ED`;jz5lN_mv$Rt@02@{^^u{_#67u_KQIB-<{T+8hWGs=SpJD1v*7uEONXqfAGQKH}78)0=wQ8 zTVd46iVp3{Zz}QYW(3_75-*v^JG5OolMf|A4>IC!mWspJ8wpTg#=vFaL)jCkbL95p z`FBElo)T#f5nNAKw+C@nT1JbCK6DFd5A|q&eFST>e0@0xurn4a8db-QfxUyT^_h5- zLJ(z>VNsKv2Scxtf+fF+_MpV}fJvB!V3C8(M5{}5mSS5^#E<8#7XKE++fUc)bIy8t zK+nG@mXw?&n-t*lQFqqAJyvWU)fX=@Sy?0GvMFbQr7sM(hyjQ%LFPDDYo)B2i#M}b z;1ubhK~{u*Vz_;s~&oz+EseZw1YKsz*;k9KX_+|CTvaI##lw+lW)2>WjV+IwD%F|z+7{oFsE0=eAh;~uBk30kU*Oy;JBU;Y#` zT?Aje6tI*TnWlN!Y$>dKO**@n=SPie-0elg_p;>+($?vbtPg@j z+@2-G)^4I`9v6rU1VJlV6=fgukYpj)>NRaFgF3h`UF7$)6ZIl{S)jZkG>;N7jR8L* zt{-2tUfrY`-8=W#J2h!H$X5%Wu}kL_-t?uW6*hZQ^!lsf^MKw%sqz*mJ;&Y8xDnMY zg6b^nH($GYTgPgTg&T9+G3=sHOR1V*Fl<-Y8WpsCjm{c^676|`J%{Qtr}iphkZpIR zXvjnR>?5lw(fGtWX_R{1;hUnQv6bn$t$cI+YHx)gdZ_pUI*$?Eh$}WW^1BBelx_w= z71jfJ6_Ip%fyWV}mOq}o4)BuEL)!y1kCbko51;}y!7s@?e`5omf0uVG8n>{c?uImM{-Kid}Vn`D3b34zAetS1KE zhq}>U&JL4fgO;Ud&xLwWyq(R2S7&xuf-~~#)qSK{GkC=dYD+AZe0Q+*?sv<`XK3Kp z)epGX!vsiBRL|SSyOsp4`xAd8v(UM&V~7K27iPfW2Ee|3<%z^=D)}+YAX8Uit20y3 z3wzeNOWME1oG0h-8dibxoXC16D{>IA<4Ng^3f)VC-o27yn?`+g1#A*PT4b342gTM_4>FlW1vEs05 zS+RXtd$!v9*JtYk=wDLnZ8=PbT_*kY$qCTB(Ek# zQu>?1y_2i+X0(b1fVbG?UCr%b^Q;h#{q@Db@C)immx~SG7KVO+YSASM^7^B~UdZub zoTDSPs7Py@)Cn%HS8bHP2m-BsDCs&m@CGCXen22`w{Lg#JMgG8^?4razfk2&Sh#=r=#;B(^;oT}l`zev)rQUbGnX>0iqCK%Qeq zB?-7Gl85Nh{%?3#9~(+`8)8u!f8q7+!hwq5>XK|>bIGQ%g6Z!|-q;3Raq6dxC-xwx zRvJ6afF+<=|(u1!IAg>42fuJqW>Yee zn5kub{j&H&n_CvI9Rf@;UDl-y)nd3&7(oXaS$3SeLsjn3&*3BJpq}Gxmd&`Z{OV0_)jaBPv%F7O93LA^BYhBc-A~pF$=xxP9JBMCM(O>LZN=iVfo?QY}*Fl6Y zT5k%~tyE9NWk>ZgY2bGI=bh?5If**z5Bzs0A@a%^DZu>?iCl>#;Ps7f?TdFQfy3wc zwBygw+y(5wzmIs7+#ixb6XZmfhCZZ6;2itJKs|W32R<<`Uq6*R9}L8d8X@UMMb2Gf zo-2Vvdj6H7*t2&9T@S>C11y66$UGl~tVki3U;&M)5S>q!wN`rDQ1*8Qvdq+8^= zx@8Byu(9F*GP-a0r;n6{=iQC3QTCn{4Z(gjDbTx2frTwzwn7ciu%&Zp*yXuANzpfpRkdZTeUNdz0sEf{LgOX=G zmx-HYi29W88Da79TkWnxVjLGFnAUyNt6y2(y03SiX65(GwoIFHbVs1E9Jx+~v4=K2 zERf7+9}#Q$IXok$i2UN$O^Kn_jI4=Z=BPv4*&Bz*L%X0X=8SOi3;p@B$!G=hDnCOZ zmF^-lxgS|kz8`!}-R|IES(mo7qXz8bD~Fj?(n@f*NK=D6%E{ z22idL_xN@$;oH;+(Ja)&3EL48v~Dg~kK6Mj>n_qeDj4EQvRWDmGI5+nZp8V$u@CdF2~6}ytD z3(IiSd>;_Bs&*3d_0#gnw-8swMLuDoHB+dPbJ*)B+X~uTGPf@fAg7F@a~7T-U0v50 zc#5)nb1l!qPf8_4er5(G`~mXI?2Qot2VpQpNPm;Y1Wq~t^(u7S1WdN(E?;A0*k^w# zFvV++mGL|Ngvs@8A?dghdHik`7gOt878umwTrBAzwfz%c+|M+&sJl*#*k%IX+epkC zQkHe|zB8N&`L$pB6YEf^2Zc=YKqvpTA$#?`k%eXT@K>D}k`K%plaxZ5bJ zX*%N05FTl}P$GgCR-<7)b|2S^#nZ^`rHiAljAQEk<@{QBSNg{)RInbO*BD4kARycX zX#9yge5FBS4AbihZ*eI=49`Wby9u^bsU|}lLV|Rx7D#*2FTXeX3_}cjn=hfz_FuUD zAH$D2C|HUbm2|W>dSob@=pU^V*ZE9E=b%ZE-x~`KVDqsj4F3%f({un)e1#g*Qu5tUs})3;Hw||yPwUsJ$qRI=P;HI#I7i|I z!l(F+Xi|-0CN6lj@ss)f7H@}omKRYVXRpP?5y`P9l@mX-C6gd0=gT>`(nrlXm+fey z?&!$WL97ne_YJ#4I5Pby5FUosE#mfKYL*0SlZVXV+lVv7sGT=JMmJ9OePSuPn>?*` zWqlkKb@Bj=a>`a2Em!LU#}KzvzGKT3(luHB<|8w|VtN0+J6~Pd{6e}VQ5da{g#dYJ zpcxf>fi#4}Qk+DQ=$`}Y&dhUj)^_VFPPUGwgYreO^vo|;w_($hp&Q5@zG>MsEjLrA?kEi_lOSZjK>_m+|0{1TwiGI4_G@Oq>J@=p6eamYmsUh=42wun zAcacn^SsS1+yl76P(AxqsNlK0D7yUgd2>2?bhu_5(#{y*pe#mUY28+9kxishu`*}A z(vt#VXoEeR8`XhyhkWKarr~Pd1<|hEkR8efzM7m;p~djlwba-JQ-i?$eiAQfAuvnS zyVpyUa=+yIo=tnG!hUbr_Wq)UxQcDBKFuZV&SN+X>rRUjzWu%XLLdM>_fM&@lb^sw zz&J`}uTs2>#XY~T6++wT*z%T_$&Uy0iovYyevQv`;xmn*ZT)b%Ka5;1z`q0Bmrqa^ z=(e}iW>1mg3Btp;`bfZ)Jn!v-Pl=vTn2@Lseut^WvytSit>9_T>&)pbL~sFre`Q5g znnY8xXURo5@DUMUVICL zu-s^Owx0_5NykoxC5L|mDuJ9)w0Q6v3tEvN@5db{;bafd`}dD|uf+?@3sud~4ITbG zR`BGN4)BEyxgRUArek-45BbcAVpL9}_sw;Oi|`B$66E=HFFfuRi%o1^{=wSZ?)iap zzELf3s&DDj&&rD;VlH<@l9H@3JBb|;(%XlKxX{{U)w*@mW;EM$2}nTjSw?*5;*5vJ zf-U*l;QKDbpsO-!#(XqTO|zuptl8MJivT&;U)b&z+wlvbci*Okzz-~@baDEG&M)Ut z(EFh8YJ>V~r8Dl@J8C1-N%VOo(ze~)cErFt^`gU>b3Wwm!6Qxgt&h5HO{I(3h|{E| z3&wOadB231!G@O%YT&W&eHLF7kn0^m;paI*$Z!*Ks*SVAiJQz2;_xTMcOTqi_e7cC zt>)J|OluU~SM-VkFJ2W_^rj2{?5Dz9xc__^rnG^btii=CHJ4NfmdpOSBk`kN0gpfE z!I-p5k6=M?}i!Wo6>K6c^QdS$^pt4z>>M`})@N&u?*l zO%FA~LZaftwjy>_4hZ7&*3SD-X&uh%h zT6Ui<0A94qLAiz(@4?E>w^S>~dGjUO+3y=`T`4=>wIEwbifg|Fx5W1hVBB6Pt{Ax8 z?;f98=MwgZpuJ|#Z05M(3M@qe=xbKLK59inS}dXa=kJ~s0b8Ns?RUJ^4-bpP5rAX6 zd$(DKR4&`?4X{&}!-nm=V$W}jIVXjj6PksuTw&Uf+^Q40Jx)rNR}T$m--i^teH_)N zxHXSMr}Oo0aKkrs_t$0&NeJ9xkSBGH#YNJZi17ppWTuBN!2b&^#-q@JAyk~uChJx~ zRjajRR13Er&7tD5khr^RnHP2C%bIog*1RMsXrE)W<5@HJ2b~ISwF13a9F2S`8H>_9 zTb)m6bh0qx)H7*T7ac|G5%I_O3J_8bxsQre^&mJYGZZxhG!y%^aS2Zj+R~QqY8A<9 zi(Zl5auyXa<O!7*O zG&O-GfaoO=6(sO4aIa-te(bXf(%)ShK23HiYyLK}XGG}x%@hgTy6KDJ@c`LcQDWkE z7UB}^X8NTFvqmhHZw_VUGLUW@f8W2k<{#EEt6_1s)ey9Wo+|&Kf#FiVT?BFxD@@0jwQ8$9v?P-!_niG@W=i?hO0GYcEaqZe++=h7}p!zn%4*yyfN z&E<*`rK;f1BNwbLb+F{0zx<=A9=nWzKXQ-fKgw%bSGs>)g2%h3T zkziiz`CPOC3fh0@N7!{RdSM%ZTl1mBlaeoip1*V14bXKjAwm3rciM-oplzkQqR38$LzeMY^CzO%rqUQ zB^1+pB}#|sg^FM4q7I@BruiW`X?3oG=%7^j2eF7V8Retg z(QkeaAd{7C@sRad*9<6GwS{Qzyy*x|m!ie?q404sxyFyuO}W`>sEoAodzw3~FhZfC zZ4S6aIvspJKI%&BG8D}*%cPqOEP6)dVlqlc(#Rj`nW4YP(nMx+17a<$xwh_C+miLM zh3u~2Hje%HkplCqZ*C-#VJ!{hOi>vS5x3NH+a&sqRf)Mppecl;a|#Bij?slZZ+Vv_ z4Uvb{yT=WXz{&PMRnQ@#JiP4C&!8UxuZnn-n%6TNjY2qoCPCA_t<@x_m6>s>Ojp7SSedJ z@fbe#NX9x8N#;kM|G0Cgo7QRfj*CxAh0HKD>QOm65&!=VH}3FnCam6Lc)zCn*Bk${ z4GyX)IUhNoIzQ;~U%LIT5l-&_h6YhIUyBL3`BX?>>HqiPr#rjKcBB961^&lKf9`~| z{-3@7+Xj7idzHxsrT@o={eOg~;X;N6Q~KLrsejjF<<+CGX(oGKTr`_!uG-G+opmFN zi0t9k@#bfxCLGM)`1PIlaX1LEx$m<-rUAXXkf;04Y5mWq-+<$djSuh8lXuwA@Zs^{ z!QH6O(yYe}m6a_ZJVSczC%s5L_J)*yC9*WJv5D60n$#MR<=C5}a4@zDGk7il>mseo+KJJ65+3$lOL& z?j4xdR+JT49SU$f{3OfX^x)864|s2%R>w0nLp*hYEEpiBL`nHD*Q0OCQ+ZEIs^sDA zy>j^!+w!jG5wT+Zei!|2$__oY(ld*A8*!|D7ELA`_dk<1Es9LHc1dnBaU&6?+Mk3H3#BtlnwXgGP4TE%Qs|MZ%5lsem5}l zx4XJL+4tFY08o_kQ8k_SyR!QWbiGSnqT2aQl#>@?7KywfP1!whV4v~Y?Osw!K(Lhp zu?IA%WwpsxE;!^@(YRb14fVi2*5dG`4^-JBy5^v?% zoMi&Wm?|P(M_zFwOksZ|K z#_dqG!l-O&xj&JG3@-8LxdvJALoKTs>Vflhg7X|MN$80?aic*Hu1f3PbW_dxQiXct z2dN*^*SF%SkBJOXjNJH3!+OJ=!)NbuYE>#ngLDhZU*HMZfPXx-DQbR8bJntFKf0)rw za-9{Vf0_BS8{#FzulY|2{8~88EO-Ua#br!3yu*j(aHs=DL4IXLoHsqlA9y4kSb*Cv zSR~2)Wc4GJH-K4^KJE%{X?Yz8A@!fcnySAshR@qi8pQ$;4%!s{F<-p1<0aFp;y zJ}qi8=;tA$)SyzKEXuAI)&?&0zdG$G!;Dd8E4|Ecn-&sRCUXxpP|T)$x|=SCc54F& z450l{tR%c__&i1`7G1NkGxwvY!W4SO>qF+o3dFla8wqc zSmoQ&xRnZOtU3~{g(}4Xcf0SWa#OA5wx1C-pvR1rMN)AIz=TwN5x?xoJWB12;5+k4 zB~`^uTG=&@FNEc(G8UiOKDfZ2h;$l?QI!WjEN~Zb*GGt8*%YdY%XhVF%=8@ZJj34H z-iG3*()r$>S8jgP{ zi7Lf+Lk@(Gdi_1c1g>awh*Wm`#vj z`6O;~3a}r#3Cl-Qra6}l?3h20o9X4>5v@F zN^$4PcZT{E$L-oepR{E}#Dbk{->^Z`D?&~gF2UeN%#i70cAL5N`rMxTJ22Tnuu+QI z_MWW`i1LWnK=;qsBU5%ny_qMlhjxfFFwQ2(yY`EFk*LWnks+I7dbZGnrtD;q66I0E z&AT~xMxfNe0A4uLxVKBTXV#Lw1xe$`JQLzvUoW7(HV$N@VT(4_a4 z2LO4Y7|ht@JQN&%v(^ZKe~*(3ylU-Qq|7(!?c|wTX+TgqNhztkz3B+P(Bqg$D|e>w zyswy=XbkKsQ^I`pM8UHg(bJm7Aj|3+M zyT@Uy;e?GQrR_mN6HW9Mc|fUDDC;th1BsxQE?a0ditN^m+#p=?;ezOm_P&S2)dJ9I z8L}$Fj`pUI=d~zJ5iA1?>c)WCu=_*IlskbrRA(xczUS88ray#oGSq=&QK26XcH~&O5EDvooNs{eJKPp>|jNRUH-`7W)(+eJf9i z_47UV*ls$3xX?Xr15qBbI5}uKOGE`{@!EZT9MvR>#7g!y`gFqXk-*ST930Z8n8xBPI1L{%L^koRuj8(v~5`^ZXl~ z#uSuA9#@&3$%J1V-xBdxG2S+^&Mi#7gVd`ig-p?09@Ifv;`mjDS~Y_|FVrKxi&0`j zbc*f&gwXzKCzsHYd>InHg7-G^-L|6@gaky@AagTCht>ACSL>%4BC|f9+!n3N3LBVU z3?-VTJgCS=)!WTT33hhZ#1VrUQ!C?mFeG*jWR|nk1)n@>#62TIEo01{!l*DuZlx(h zVamBz%K~C8Y+6uM=TD;TOChu9y&REyIRQgfH;>P6y5fU!H{3&UwoWlgo!J#;G!7M0 zcP&gmWIm{bn{&A@G`%B9jYTLfU6Nk9_iHZ1;bFVo{^Sas%grn4c}0`M;>zD>#}Q$U zXkutRqS_{k-_DF%WM_?hM8)AMH+^@()Is(va=JNy(2s!4$_fXIDG+-}?)mpA%GebUQMRYo>-|d4U*!QJqQ)&Qk>tRcuyiZS=k;hd>l#XnX>mR!nfa#E7DtH zVfWAj2-)*cW{elPikv`+zPX=;Kodk&KcSL(%E*+8>+eu0!M5vn17e@5imV7QC4TBr zPS&U7Uw>S`)DU!1j`T#A#I%X=RTyq{jC$yo_Er^fr<1)C7WtUp6R7si zEAej``hKO~%lh!fXB3kAawne6lqJvR6p)&G_l$Rb#K;xl@ITJKxod;_@iCPZCffxO ze5^89FM6A-F`E(nO|l8hXnI_-wRW6@ z6w|GYCk4obB~jkD1mqfD#p;**G?OhYAeLOwmf@88q%7&U=(fF97kOF|($(nvNT8~= zK=#6jOkiL4_Cr?+imhtC^+!0xyMW}b;H=k?r&lKh15kc_(0TkH?&U%K!e=5DTK-Q) z`u`=JebtNhsW>)%Y3-!X(+l)k8hSE9q7e1hPF<~k-bNTk|EpMQOjr7J)VA_;Rd#SE zl_G(n2= zjb8=ApBh)l63>o4RqoIFWxFfn9{=6i685opYY^9WtyEXs@mm&p)91)uNlGMWb`wQY z+u33!zEX0t9e1B{Q(FHlNg$)bm}VqU_V!f)ZB%Y<@snu``vbsWJjFhry$ufVWvG*C zF2%hL^r)F&OY>S``<5=jasAqpUIzc&E6@^<`fu@zus~HP8-L~A2B*i(8a~}#Tp?ki zuX4Y$IJMNoV|Jg(Ny#%Wweg1)T$oKZQ9W)|j}O}V9w^JE$r0v+Kp(@Lsny77?{}td z``!AC4Ub@e4!TzZ3v4eXpD6DNo%xbxqDrQtdVby>GE@Svs#bBCYyx&`W$SL41nSej zehIU%^4V;R33aqH2(;E;`F{MNx*wCBOk`ri_mEr5-CZa8Z!4$q!g{%i!JnFuIN7&+ zo7&ywIj_j+qIlLt$txnBbPfw2;W!@{3;u194aB!!DCSwHe)J&Oe_;*QdpmeFXkOl; z;y>W_E%dNLA0%NT^4*$P;M`D-aM@GY6;_piTA?p_eI$5Mm?$zNZYW)I;aItfc|SOB zEWl@*_9+;wf%nSPv&DzID2A-Uj*Co06qLgzC7=6Q~iXlSNiCS zT08uN_GBgMu3CJ$<49;z21W7KTu1P+hZG-haA40riQtt&?2~h%xDtub;)uIfe2-eJ z>_&vX#zrBdh9H9S#Yc(Inkt|ZpCy1rfUlV3YbA3 z$`x-N(bQjMp=MVoIbsbbVN%uXJlDZjMU7c}oCFS{ileizc8Vd%WDz=Mj{ia2gQVqynX8pXND7 zjDYxhBv5}^1Zt{Xw1c*BKn*qPcEiq>P};&@)#{@Il_NZfwR1U85fzi&e4+>{Y|e#! z%t{1eXov*Er>{^UIy(MztOqJsZmGN8c?V^|?8mef7ogbx@$~|cM^LgMrr`4X43zq6 zJ#D3_hAIW_rXz7OKy*2_LGS1Vgm=nP%_+@L5iQ#w9Nq^d;kE)FX2!f8}n zLf);wG6N8J6;$5m?uN3$gELD*^H4$i#3`an0(I`?5>Zzgsu@DJO=^S!VJJ1#GK3xo zGtbNul_G%f$Y`H_&`l_->&qL(b3)l@>%q}?Gf+8Uv$eE`9cmJmZ6j~w1M%3o@v9Yx zQTvQIFVI2Rs{Kjpo0Cv{^Y#L~_kv? zp_=vz?VEWHsPrn(($PZQkkihs7)b|W5r1SkjRp_|tmWnIdP2!F?VGI66QKN+%I;4b z*YJDpYjesXP#WEMf#cRRl<(-I+hcJOipBTW8QY;AvYV^(MchVRVy@cbK?b7Zc4p2N zAt-&`GQ5k^8Y=EukKenZ1O?frTWUU%p+Li6`S5ufsJxJR#U)=K%5)$5WE}B;^4`go z3x|fFB>rj6fu(0a@TzC2yyysJTRzL~`&bR7TH8lFi#7pa$Dab`K2E448@|75hI9Fx zrf7US>UMt93zkot;T^-)iuQ!(P%9^UHcBoFs?|CIG&`h#*exN=aq$LJ2Q42GX<>$% zdfS)hC8waQe(%AR`~y%9P4~n6a5CtT0`g} z6j1-ZA3x`_!xO4PU;Vmx2ldiSqvUzNGL(i@?$SIM4<+LBnZHlohtivs+}9hvL4{HA zv$iU6oKw^{cSb4zp{q#1Lmc^3akZx+Z!eUQ!el-=?*KwhDxJSvH5A9+>3^Rj0HvAH zfsSnAP<~(BO-)-0%6w#23cTi_{6W+417cKAW~0R&_F58(Th9%*`(A;vikOKlpM9Z# z_E>a>WiRAqRtXsB--05}+`0ZQj!-oEOVM842#O;n`<(JDp!oV=lVVyH6w!qTO3tN2 zp|iP+K_6Vyegg52(N)bSo1nswyMd&K{=xj9gm#J> zl+j$W?tXF;N{`!Yxih~CRZs8KZ{nv00$*o|Cw(6j9;>lB)iVYq6R(njPs~Dj^);@+ z>LXC@w$Q988U>~8m8sfn=BNYD-B!5VA@AqYCz70~Csg?ooZ%BtDzEr?=c`YcC;pT7 z8Gk^9&owX0=z6Hgy0iNP{VgcFn=9xO$qc3D-MgN=e*;8;p)WrU+=PnzUsDUZan5~# z+LEi$P|3Mi=_fFbKGJX7vCB44$}||$6NonPxl(Ra2GD zKReM4)wZ{@KZiYsf)~`#%svCe_AAysVVO`Fp`(;mx(^8Hz1==Xab3SZ27bV&ls8W} zOozxp`KL?55rG~!&r+n{97F$Om??cB(+{fNTi*+?+6iT6jbtbKZXgfG#SaFbhB6H| z1}YwAD06BuFku#ivdE>KK?8$OPA#lzsOShK>!-Ro8c@gf@JAHJ;`2q)CPkm&`kK%A z=tez;+SeV%mf;;xBOUMe>@^ko(u*~Ui49Px(K*5U{1MjCZciT#>JAmznO8dis`ojR z6qi3nU5?Rw#vuyTawlzTo!8-A8g=>YyXjc}vr0RtYM@wq7sul?Qz*^bE25)d4(0Mo zF3rgtK(tDD;a|f9N25&IROw7J{j@?k%yPA(7Vk#9$zNX$4UI0WVD+xS;IpUM=L&fEsb zhPQwqlI-qqAq$9pE5pavcL8DC;j-dG3n-WVob>(LeyC8rc)9wE8B|`WJGOpm0jd&S zhT703LYZYxU`tdj)>&VN$ub{`xQ;Kn8lJ)YOy1pc27O-9;4izA=x@_Zw(@KwLHS|- z%+03)p)8jzh-zIQ{aS=Cp*|VjiO}h22$Vs!zZLJy=p`W5t_Gjk5Qgf*X^GFDe1PgI z%P%<`o#-#AH`WfYLUptft)#pcRA03Z&bfOWsxQ5vdRY7#YCqPDsJe|ojkzq#bB%LQ z+d1!(XH^T8wPE_1rG`-cuH4yWZxd8%yR&B)VczJ>d@|+^!aJsKUfG_JK&aW}XuMAm zD*VF?H-+PQg|C0qM^FujF(KaHzGy=wub9?xw{jqkB^ACkSchu!I(|djpHOBHuxZ(4 z4-hPSw2~CYp-hmDeETOTKAEz*Y9J0p=@H!p13XYJs=7Mv z{RAqXb!ZpQGeLE{y7~RCdr%?J7c1>r3l$dk<6|VUp;UEyyv{oM0sZ&;Eq?hznPk(5 z)iHZ0YvJ1XHC_jV!-F;6<2ZjBn49~_%1|y*KrMf(7ODkyg4uUG*O(6$GSP|xVes#5 z#$Q!XOzl>|*kT7ojDH>2xi3R`XXeLcl_jVY&b(N?g#A)-)-juk9m^f^u><~di_?Ua#zYP6eWOfcpPM-Pjedi36*KBWi{*oIi z1ru4DyFZ|R(bVd@uLU*n3*WjF_Cx7WAF;#Rv!R+`*H~Aa4aJ4KsW={aLy4R8pyCm% zSE6yh%s<_rvSJQz%ZK8{;IAi7cth5%T;X@JDNw*rQ6c_jFAy9!-YX^v0#VTP2$M-4 z5cfv%yRsPoVT}K+_0j_%+zK4kzafLZ;pF!(=vxU-g@3Jm9RD9oNqU!f*&Ya4dBu~h z7C@-be^!@z8HlQP6Q;#(0^w$$n%JXYAj&=%-;Vx<7{4cC<)aD^Wvps-ruu*|@cKT3 zFs|cSsARDw4-g9VV%l?5fbeQ&chNRqAchAYj`^B`^WbK-ns*`)nmnTJtse(M$Mz+* z$J#*n{;@!}Q4k2z^{qEoGl3{4pq%rF2Z+1UyW|;h?w$92q4xv*lW*(LMR!SjU;U+w zoDLu)#aTyloWcG+7n_yM2tM}$2opc_ZRx+L35W4Rk|B|o`2<^M9<$oOlqL$eCIQqjtblTn6 z>AeO-XSqjHnaV&EW#zp05dGrRZ@afNu6W)4u}4!qK=^iq-$wTY5FJi>xu{bEk?N+&YuRTr zw=iLTB$~H{)B_==mixvC0f;867J||eK>YCY`u!UvK=d5nq0JWx#Gjf+UUv=v;m&*7 zBdudVv?F{L4PeLTCK%40w+2F4uUDBjt}8e+oRwlFfD?Ty9N@e&mdPVg4j- z=m8)yZoO6?U4wZjn`xyU!u&-nu0@aH{fT!9x^#dTpmW$t$ry+yOEYSxlYvO%yYOos zdGo%KN8oNd5WL^=MY1_ypCqy7UBkQ!4oG-jH^({J*^w>w42W0P-uxos`Re#tKIZ0L zAbLIWmiwWL=jUh{bNvD!^u=FQUdDCu*D4~a4;yFtf5O?qy++`X@ ze&=uvZDzze?UWXj5(dJLwAe5K%=c#HJmvFYK!|4wWFX-CbTn6TnF28HS-Wa3BA=TW zPmjHNioCt^#rO~}_U+H%T?6PFWMg`B3YmfU_yEUG7WC7a-7UWS$PaCvL+3;;1HpsI zqkI>h1A_h69|^KzU+0NYlUI-rF{f3ie_@{fXp388pM5usi)y1n9?#6(9mGEVI;0Yp z#Q}tM`;n$QxDMTui`tx+?>MIF92-CEx6hAn?na&-d9wA>44!LTdbr*X(jm{!j+@M3 zeh%22&wIB82!4WBVn4eBQGVPobcO^(_THDba!_}^zmqo%vB1x(5-v7l{Zlmy+y8cB zJzJa3{CNw66F>J%C8`7Q)H(O3Z@%I_gO#fF=7CTvoOz>s3lP=$Zf+dMI*0I9Zxamw zLXmyQVTNI>Ym`nx@<7Y2z6S*tlz=EDAuOWVkNzbvWp5|mAAZ1G^`RKn zk7nt`TSTro;8R7NTH-X_EgOm73lQ#z5%3)Rvo4nw`<$`#_L-D1)Da~G3&;0B+!PH@;7pI%Tc_V=u)jnZH^<|Xoc|AXs5xI4$4 zvmA)J!|Jhg5A`sRUE<>z()O zKs-CUsn>L=j5F&%143F zl5(AK0C|2#$64zszCS+kWpmDLAl&b0l^?))bWy$m{%qj+cclEH9_p+`nQ`ZhLs++3 z;lv>+AUt#)_qCP<0;%Aa$?+@LzYN8!)wG!Zh3PjrjX((5$iK>sJdEoed1&DRL{p0_ zmTP=Kq_rbAgypEz=@G2c*%xxVga8N|=eG$9reXcHBcp!d zI!p8=Q{^;pE^+kkUP{CHxr@CtZ$IYiLh*`u6@LFWDCR^U5Dg2X=^~Jan-{kFaeqf% z>CW8lS;upL@l~E02_Rf&+i|W-4&SRtt93LjdKI`EM)b;bKmkiIN{;_LZ2x>t7>2l3dPjezaWj|Un zegi`C3ghA#=eQv2okCK_lezib={hQ5)>vUG6qoxXxoD{u_7> zCh8QoBTK1u}`W#%xq>^M&6wB(_e8w-r7(1tm1x_ zPTWzxf$RUZJ=$$&CsZ+4Jc+-h4@BmRj5$Y;56ofDV~3cr?~--7kMSd)YxsxvqaN&U ze5f!rgY{>7xLSa9Vou>ZQjdCMA9j|#6xVZzQDbi=&e{0d!fYL!8#fhB9RJV?gwmr~ zjt`KhPyyDzJ%ISE$S-^a-y?CN);0Y#5QRCDg5IHyF(mXnOVzWaCa4y|nl56(S1R~vz1wH8n+~3nrvl^JEH=9f^eX9VX zp2kl34x9_`7;bpXFkt-?xpxh>0+B6v+%gd7UW-Pe=k1R;$34b2$>HbQgeJIDs({F} zXj)N$b>Cg`=+EFyAbOv*krhCH!e}XSpT-gW{imdTHTYh|60hTdSZ~R|*TRzqK%`bM z`7Dlk{Zh{Io#_e?y4d@}4OLN>dCZKM@I9tCU)pu!oU`n>AH4n>h!$l}^4OmOG4yuw ziEgaJ12JabV`4y9TeovzMLiYv{@~@)8O1Gc_nQ)i~Hx)Us_y3{)({^1y#|vy*~ba&lK)MJN?&%pEy6n zkEUNDmEwHSRzFTceQDNn-t!sHL#MA=v@&76?mW7fy2%c8t8dTTQ}n4>g~NJOc)o;D#$M*wHw#_ZYmf)Yycs5x0aOuE7UW4{xOzmAbt!zbK?y9MTTx8 z$a4b1`cos;X>>5_KsTNbcIJt_L_hhxn`U7d`#$!5PJ1xw_~ZbK zu6`W$ldJ(v;uAa%nqh83?T^L3mHSkD6J`Vj~0nM8`_bt(fGmg~o z;d-dH*6kdQ2cicfSSzD1HV9;S8;tX5)~Nqv-d!L*Oz@|RL0_m++xImJ^R2`xsw0Xz zeb495R_OibpC|c#qOO^<1vb?GMICQ26yrvHvuN>l%*VN7((^Y~7k#U7+>!U=s1x#A zl3M9T*kTjD~XsFbsziYRq4@6DfDG?YDvK!*#D7LIk|Pn!`-X9vYarF>$asT zSf}hvnW?XM9>}MD<#7kkeI7P$v>Jb~PP@(RgU~mQ2n#JJ$*hQ|zOCsdaXEejz($3Y|y2p%;maoyK$8mmjBx_TYV= zuLqs-#q-^VLV+$;X&}h5%>OxSgnV;3dEB%R`_eVx4>!(rLgIsS2ayLEi8a#C@jTGq zxv(;ieiB|BR-Z+G%^i^Cz6X8TCg|EEd(Ovrb$vt3Fe=rgh|CV3L@x?|>y@#bwH#y$lx{_P;CVZCG8=OgShpe`3nVg;+` z=bit)>4f8a6SJ#c=fNpPS6%J7E5P`|(?;*u|Hebz41d|!7vW%hx6;<8R^XRdymbte;G;V2v#qgfaW8tMBe=KX}2Z03?b{|!m+j9XN^3LpJ z+^q~EZ$;kn4CI0#$!CST;~Gef-rMyd_a~?XKmBVouM6^-_0N^BW`M5l&8Yg%TS4zu zwz~We4ba>cop+PU5j2xn_LEqMps=}hcSF`4a8rBu*^9dhG}R*yB%?n%N)|GLkEg(T zGy4wJh;lITX1KTVJ`OlfhA0>;*}=Bo&)Usu$zY>t7W2zK7Zk#|>CcJWf&-~L{2gC- z!Wk)Zws{pzfYMGn=iwwU*7Bov`^gK(i#sX@CKO?RqRfNUfFmF_f1TUS;|$0=FGzTG z*cH5Px$C}*p@+Q|GF1GrTCkV9VCqzy1z38YfAljU0*>z9?UA>n1gdG{*V4q57} z1%8=;!$KGGZMJO!t#6`xTnIXFNkyTSsWu!=GSi#y-W(4OZzuNmKdJ+nn9DB1haACz zl$&r}vJ z<_9%HOTqNXityghHc+dL;&`610&+2X2Iqv>Kzdnh<5!0mC~QoAep(X-rY~rEF2A7y z9l8^>S|W8Ipm%hQs%!|<2OcDya-Ritj=F5MP*%{1k89c6y${%8#&k9RmV)Dx%}+%v zxIs};%vpv_3EbHFj!Zh*fKr>ntmr8F=HJN~N>6ia0FwiPdeW>oB&Pm2-=24*O| zv={=%x=0IO7XeUPx|9CA8NgVAynQ78J*XGl423IApgC>O^TX&gIHc9Sdw7%pR%##B z?Zh>~>q~`*ZDu9-(YgwJ+^~a7N33eYi$y_fm3jE<%dentO)%`p-LGI;u+J+bd><%S z6Ju$u8$qXEy;mf*1av~^WAnnAKzcoFk|NQ?eO#E*gkFGAj8*Y`v@0llJ1L~8=?BN$xpvldzXS&Z{`ad1nQ%0hcJ9$O8IT#K zjsH&C3RWw#@ALayL7h9mNr2%9Xtrtys2&Xl{)thMgfJh~>9qV_miHN;{@k_tIWs-z z9@L@n%>4ofy;yi!4txSr*FzHS5n7;k@#*1sYAvv+-lu-p`W4VmaI>zc-UA`)OINI# zb--<5Z=gt*B&gjCy_9f!8yKzbczIrL9<;{2xsKRh1^HRQpNytS;Pm30)34u-aAZYW z*0)FtWQQ62&Ym6y_3aJwcI+oX;GLJsRu&r&4h=UiOJoME@}|@C-MpaXlkc-FV<)J7 zNmu%2?g)G%!U9Xe#bBG?cw@_UC2%G*&4>+u0!zJ;2a(Q>U?N?qw}XutwvtYGGX4ot zt!@6Y>y1AZ?77gDdhy9kU>Az79WbN?SCtj%mP7l1cP%6?QMU!mWEDos&NN8tnOb%XKFAgHHi>b5r*QILv;jX!0orBh8dT*i7UULn zFQ1Wj1(oxiYE-Y|Ktm@;i^)+GbWVqOKAJCpV*}n~RjR9?83gWj5ow^Mz}tBFK@J?@ z$)8h9RRJN^WA^*!hhQHYF?9?11ME)*uU`eOu#+&f0(kcag&Dp@ED-Ph5qVtLKr2{w{ zGCB>t;|IE%VIi%fKVa8GcT-2U4iL5EcTxOK1Wpxmr$Zm^0drtMjefKlY}bqoEZt!W z-06I2PSllPnwSyi8+8i!E)}p}Jc;x8!b=m9$~%z1%Kaduj~~=^R?Vg2twGt3YO;e) z284-W(?`9G;E?3NLz<`sF#k5-v7Mn2_D5W^GFROK79M)$rrW1F*)J=-cA()i(g z(Mtz3gm%?=Gg*Q>->OB0`#k8BiGQkU+7FIQdHnZGo`HV1=5P9|{h+EH|-IFgsJQ`up*Ako~}{cU$oh=p4wEZ)n>E4x?q4RvOYl*3_+Vl71en zT+Qqr*1rMM)skazM}y$7qt>q%^cTUrLdlToY%iGF=TtHrjsiGYoJ4T@1pC7tZPS#B z0pXEcvhC{<;Cpa3tKRY=Slz0%mEeB~o~yYXbk`U_^|Ut!f0{cOiY3^{3CVypBZ202 z=MNB6ZyL^4mjOLf9f4B%%b+IWV_9MP7UW}2JW;+W2?BBv$C!6)g`;~61?5*MOM-BnF#YuxRA5-7 zGxK}I7^KABt|aFh0B^Tb$K(XgNvpiWLI>}I5H-VfzIVvc3+&JBRt7B}%LQ z-c)zO_oE8Pnup3;lr4ZPle~n=H!o0Qv_0nb`y^brV4{)p^&mJ&Rq#E%hK7d^0a;e_P9WZuGeEC>)SXR`)RO zR837&=snd=1-kq~U3o58Q> z+^P)%GgWu|beq8JW6RR*?R~Ic>KaW{+9puAN|UU1hXvGjcz)QH{S#!i5yhV zo!r^$!C90#_0t%_3b7Od}e4Tr9;v!2Pk=dv@KcPl8JVV;nz z@P*BiVUl*vPr*L-TtC^tF{?w_*y#=;&^0&L^HNas-)#&{@xIs7k18q(Cd0?uf33YQ~f!#XQ zK75r^pdcc?mEVpA)XSr*S@w9tiQLP{UVOK~Bj|6!K}~%yTz>r0=EpfW{Blp&H|cTU zJ00@y`pq}6!C==y&)#!9VCpz< zxvt^`XiZ5JUSr`={i<4dS^1?Js9N!;vPNtJo$X)V9~RjU4sQE1=hHkvi{;!Z_rp~< z7V31;tH%ns7`mOG)3AZtoz&eLPBmw~0*1tgj literal 0 HcmV?d00001 diff --git a/data/s1.rdata b/data/s1.rdata new file mode 100644 index 0000000000000000000000000000000000000000..099c4242bc9035168cf2a1f610f8b10e7bb450f7 GIT binary patch literal 34064 zcmV(#K;*w4iwFP!000002JHN0R94^jK8(`c-QC@w#GD|Zl%lAJ0f>QOcL#{5C?P5( z2uQ04(&c?q(%mIp(j5}#{+)CFpYIvZcl=(R@r?1j`0&Duz4qQ~&AHZ$>)M0iep3ex z1_uT*GBOG>N(yQ+3QE$iR1~Ct$jPY4=>KQ@x;hydB`4{(|G8oz4Rk`srw1*TbeEu{ zK10%5#1N`GG7Ko@>fm?ey=vz*ZI~*1+4OO{7&`xQZ}@*inBV=fQS!wARE$19Qh4nH zOvG_&m%MXD3hn8f?blOKb%}?QWBviu?ciWsQD3P3Q?Ho?@woxy9XokS>yZI zen9gTNrg{yYp{Oka2s=45-g?j${A38g;|=9GgqVoVR&1X+@G=vmRC2kGN)XSC46=9 zpg1?I4xJV0y%T`U%5TG+!@OW7>0;%h>v>2{b@=FU-5z8XPBpx*N)1~I+P6f{Jchx7 zdA>k?C798@mER^xfCo#i@)^2U#iNiSJfww zoAJy;@9PaP9TEN8)i(xd8rvQPFQg-tu#v&fORtcMdZhXK-CxKjJ*0GPatYbfI(Cd$ z$0ARySFqaxD=asJ?|FG;8=3CgDpvN{BlF2^{**@sNYTA=TgYNJEc`qsOZiX^sY;54 z4{W?b#yMIiT?;bgB6)6bNF4>JRS#vk^dQ&v*as@^yC|#2;qA~rff521vR_^bBcH`J zk#zAuly7M4Voo3OUM?>%yM z-Vb@IlaG8~&yG{K`J-^n3qo_{B@~ayx%Vw}6s2x{r6+u!K-p`b?*_X#qk@mITH;+% zR2~%j?bLk;wWO&WN*aHlR+h~ngNsJUGxKZatX3g%@pUozRJfsL%c+w;&H7RE=c|^D zc7N13o$_MRBM~)PZ-=O?{zgq>3CV*AR;ZaLJ&;#+7qwi+o`-!y++oj6ew&L8HN40^ zmqe7}4#SI=q?lV#J7?x*#aJHd+w$fX(Warn?#-<4lVqsxC2vRLtd9maJv#>bM9|3j zbXmuhLDb$AGjHs+g6bM=UW&h^ap$9wOvVi{luD4vrr2wbYP?b=jC)D@@nX)U@t!sA z*x6~VBO`$5Il))nn1RMNyymw~Xrgi4TYAxMQ`Fy1*-pB98-=yh_m?HQp}OB$mCVK}tAoN26_R zUDPpVEKv4cM>X}0w(_(%R2L1-nfdO5=7y-R-Mpi`C^UpJt*4$z@d=~0to;2y zQ97jcj)fRH#Gxr`%qJ#^Bs4HKm zr`Pd(G+mX9_!N_h<~b`%85Z{uz5Slhd=NzamA-}f3y9`@l3B;RI#B=Kr}*mqDroXa zci5y-AFYn>@nXpsLJKdE(Ho2^qm#hL! zDMqXshQ8u1^}<-okQLnhnLO^;MG@R}ru2pQN)_rC%1i`LEu(>dI@fW3YBZ1UyPRls z5>4w4-8jD@jwYGQCLFf+QA<+XHJi2)HO4n~OU`bhR-)L#j_21=C#1Yn{k9>Z)5_wh z(^Y7EaQ1@Y*a1`tI+=RU-4r!*-(QW{qC?z$x)tsVq2gW<7P$o*lonkIpH{z%yPnNG z=ei+?d^MR;QMHMvsO#&Rt;>qL+m7Dw5Z6PEmBN-kdvnn&SlQ-A9x1;KZiVL!44|&* zy?B+Rb=2@YuX$%&BCnDETp zWNjX?4SzjJzlR3tdrK8UClJgZn-4@^Lrsd@bKi4JP&aPKp5yN=)M>Qf?Ipj6QdQ*> zyxSV6n<+JY>xVMxx_W9)6XI~k`EAM4@n>l8v4w2g={9n5|H&>%7(uOtO_?b|7V2#} zjCg0cpmM;1YW>$?R5kcu(_xT{8Xr3(dfT*73zBX0wANAYP`G!>8WZXaxUH?oRHE8S zS=yJ|La65)!1jS*8+ETZ^Dx|9M$wC`Y3EZ&_B|iVwNgKfI)}<_Sf3W5j;_pD%b!cA zaf`dieb642nJLfbaXdk7-6zZ}FHfSBoaFP|tU%Nhes)6V(kAj8Y34V&!%XTs9rpx~ zR9`P|K9_Vkhhpgs6=HN%NP9W(tkaDdq#kR3yfW;8oDE}DUZ2I0P4RR7RPQ3nW=1~C zzWx?j57#bqjZLETh0h_Jf4(8>5@fQpZ!%RaYs%=(LT7!r4mbyS5lEEK3P(>fLs^xo*(UJl`c!C=0VAIfT(C*I`a$ z+;paZ7rHZypHg2AgC)ObuenbBg;wrlrA4tz(0NEd+HR-&eFinQkHkZ!C87FQ;kiQhRT$*{KDM7u41QJ3>y#?$diZm^Hz;!AJk!J;_U}vs?X5( zJM>xnKsZz${4-p;&<)KDTPpkVwV=Tvjk96rV;K6iZ8`pY6S@jbGFVjoVE&>xEu#s- zNMgMNQ;P;PT-)O*SnddImy;vx6@EdzhS2f3=zCDw)zCqfGz?8Ed$at{F+zJRvlQRG zcTgHuef*yE5omL%^7vBl7mzBB~rW`VM{7F0r!ycOu zK-mMGiDP@r>EvOke=}V^=`u{Xofhw-v4SmU&$HwXelQ?0WclV^C6Whre7bpfAB@U9 zQjmXt1m+HeYI9jLK}*|p2{W@-@aIj0tck!Qr1h7&*Osggi$!sVI&@56*6a&BenSoI z;;V}N471SlAfK7f%@{^42WK09vcM1r>&d&nD`EC^f5?d67Hm|UW~&zzM+%RwmtSHG zkhUmlms06zWM%v%d^Rx?*~kl(WzQrb+tuNTjD>DwYpX2OmQO|YWA(u*E5*p(<@ScM zO9eTsBadvAx*$j0e0|rSA>=gMem-$-6*+(JqaSE~j9j|*S8e)8eEFMio~o-Yax2<6 zSL??ica&>I<`YTeVbSyQooGRxyZM$b8iUBoRP^8%7ZvgzPn*3#$~)fTLBGr2e34JH z>GX|?v&a|gM~Hk*kNmXp(#M}XLVhPkVuu7J@_*{RaAoW<@^5DjQ}3ui0VlGzhBeJ7 z5cp_hZs&6pDBD$kG(iC+IoWN@3$7!#ubsj-FHRH<(%?%yEr~*Uk=^u%E+hA)GQ!{6 z2FRo$U`@^Jh^l>(LWb;As5n|(Sxs(;N>-hOm)c#(vv&MNnnVUN98&wLY_g2(?sQ6; z+s(+@6SkW*h8o%4mUf>qeuf-FdU>`{r%wviMI(1~n9z7*P%_t9-OSAjY zY(A`4{Fobwp9ef2bN-2DQOz}H4KJV>6TgX;kP{l!*47{N(Lj@5?d1CnpW=?b0B+L~ zA2hKZOOhHtfMynXf07Q}MYws?;9C7MTI~5{LV6Y@pQ3G*Gs(}G3wL&DJVTA_2fY$M zpQ9S*scZ7T#84x-u%#`5#EZKe__RMyBEC33^N#5~f?MO1Mu0!+^>+;uk9MMQ4STZI z?=@62*pOEDXhQAyAY01jE!3HP_3UZZ3*2dOz@2)PfEHYzZA3h$arY#<&r=I_+4$578!bQoLQ9>LnS*aUad+%(^*g2WXeqS)c#mr*nn^hV zbxR|foiEIA|6qg`{l-G+bhBt07ioOyQ70pr?i|#AucZ+CH5WC%9JV^~KY2;VUbqyu8%^$Wn^YARp|12X$DP|F z2m@@-!uf1aYv;FBfg`-AOZjz>slXg{_T~0uA09-L8z${7%Ord4v~Pbr<%aq@c8#gk z$fLnsG2y>bVQ9j+Cu=(974DM0-Xo@_h9(rkUVbO#C^iO5-PSt`YIK16`NP0BT#avL(}Hp;p3s zCL?wde;p?ru6?11I!?E4h1ofx{57M7jHWT9_L`SGc#|6?6I*pJ<&!F8*vwTke^OkH zco{CeJA?8kM()1VJc!~!xg|v|mB^fZ@0e(k7t*Tk>}X(nfnpH}8Sfvaqe{tdeJ0Bs z6lB;R_QrS|rTADl^t9ZN{pvv{57h>ge8pGQRIh{TZ(@FWIDJ7)@*=@x&l9MXbkRxB z`v7VRWsh!@^P{}*+j1xKVbnZySM_qDFLHSp4fu7Cu9F5 z)u|Cwq9HRcE*V3yygTzR(zZ};>3sLym3CCgBU>!U>p@uwZ$D2pa%5+J9$drzj?`!5 z#$HI%ATwvnj);dW$S0O7C&hCDIqvgzTI{SrifZ>Z!ndm3oE~G|Q zGNX&(#nBC^T!G~yZyd5b%-K|^TYNflRy+1My@X{==?AdMoY^MJ?)QPzPfb@y6zYM;CB;-K2@D+i-r{#Fy{WE zrtS=b^ex9Ij@Q8I@9>Tu(L*qD>T&l$wLa*vljG5)HiD*It3+ptN6?-gm0IzM2fFhT zvw}M;VZh<~*OTw(phY&k&}roal<#Af@JZj*W1rGKJ7yummc3+nq25VozcJQgTzHi*Ct_cueJhKQwKRU{ znU^DsgxSyCQC>yb$vU@p?+uZ%-sxN7>vqE0`(Ev*`yHX@$wjB56=SgM9!kCImMfv+ zZ^`LHuEs=Whx14MBySTbmSm@_r>+rFDR}&%ov#uGGdxcZ{H-I3QFmG}6g=ZZ z%619SELs5~eXSWqeC!XRz}##>oQ(#FY{~%xW#ybi>WSdnQzG7kVHPow9JdT;Ixk@4J#j{i?-!Z-_)%z0>tO z)BIpNFl*lw>lq{~{hBiOM;GR~&sP<4-XJpZTzUU@XqL!KDbz8R5J05r9z9leHkc^H zZc!dNyG0am&40Ibte!~AR+j47Rzc)9FDtojvPl%~Y_zQ0wNB*RZayb&&QBCRm;e21 z?KdJX?R@qR$s!^>qY&lC6FG#2`TEZu(W^vStDg^>s@I9^c2@So$-0EK-!^Acb)FMO zVobkeDAp3X`#!G{SQ?NTueH1 z8$^oPArGA&mP8h&;OG0;w~4GeYFGY9^$;lr9X3m~+6YtM914=XFCxof{bIjUdys9w z_Oc(3FRV=6DHfy(CbAus-Xe;#5h?Q%T*5b*U`C(1b8R>q8VGWR#k7);@GblJrb;X< z?W+FMMOcRA^A&M5zI%}JCSR5$UoLWRc%4^v^*{=?PqznJ5|K_o|EC}Cb7c2^nfg3@ z5>`~Rc3v5_gH082yL-Ajke#{Cvpb;-S-gwMB<+HcmpMnOoYoN~!=p_&Slv;gzemnB zZy!n}-$;f|Ta+l>`Do^o2}+(h6gN&&f|3@eRx}f>QL=RRg@8b2|f9hH|@($DQ zeLB*Gyxk5@_MLS{k<~U{gQ6njRPkgy%EgaNx^h39Rc(;F_sQUkPie?i=6lj&?FS0U z{|JHe-Y8ZGxA*1dBj1tr`{JuJD0c7WM^+XAln`&cI=@+tGVw8wjg93{(f;j5qv#{# zGB(y6YgScDP1dbw4*0I7P+1x1h{K~m9x*I5YgEjam8v(_+SS4sPSWrPBEjXm- zBr5M6)ehX%glc4GywktRq3Y#A(>VGGROq(yYf3zY(w0Zdzg9m-X<28ZsMt3s=TLC@ z3n2kzS!`-LR<}{?9U<<(?;|J`Y<*rhY#U{j&$Ij~twgCs)954%Gn8CsW5`wXMe&77 zJCVEzlx!ABVG?UbiG3&1;|hPGxJtkB#-IjrO>BB4KlDNg^FX zd9{3ur2xg$ZWq#|=A(Sb?xt5S?x3=s)AzJ|f7D=ES@wRHi1M#@(?(hQqCz%tA@#*P z%FaiPx$P7}$?QuztX85>q_UY}wsH*xpFSvmSCoyCA7|(*x4)sxg_2iRRl%r|OC{T! z^aj;Gp!xeQIn?UoaJa}Nhw2)chob|mP_==XO!tfks+BSx75{61Do;(PCz{4l$u+TF zN5%uyb~_WFYW1Tw8OuriYm2D49iC00dmUA{FC0j|QHLrXpKoWpA3$~66Aza|FQK}Z z@qF{#6I2_&=*H!vj%p!$-cVcTql&lAx2x%0sBk5Slh3pcW$8pX@^4wAqGCj8%@YEu zZQZ`c5WWvJF4}NCjo?HT)#ug+Z$3taLuUth?yI6o)-Lr+M+#BJz5i^uj4G@38;3gnS)}_VN`LHnMqiTK=ov)1H--3s2b(J9Q_7SO_@)?&?XtxA#x(` zr#dRtq?~#;xrj2}N|$plilBmyiLy)eag=k$N{_dHQH{IV`?ta^(*CKO>YZ&wr6jT^ zx;dGsSadU)35QWB_d8>8%WqWbIAz^(&={4uWIk#;+M;S}10ANTq4JKq$sWgePyu%O zzd9L#(o(^DSw*j)^nI(~*Sq^se!VTK;_8Qv5L%as*W? z#fum`NxE_NGu>T|KvcVQ3`^8GLipVe&+w*d&ANS?b7pA>z9CvFphH?5a|$dIyTk zP&NFnwMFsUa>4gcGo#qei5cfeHRL_~_-UN`M-(bPOv|NFh!QrvrkfoBDA6!$5gKNW zVxc?bV$w+U?A83{OW|iIdWyw&b%z@YmkMwvOmw0+`2+n!ub-f#{>oZ~{X3L@bHt3p ziIn%7dJbeS-l23#nCXSQW|Sc_Ow=l*L7DwEspO6tDA6MLQ&-M|R3G_FpT7HuQdIAb zIr3DI^g>W^zOfNXAGC{?x>A7L-qPc(XQWZkQ}ZJiZxD*TEfG($)kev|n|7s3cTud- z^xyZ9Pb&%||6Q}$blA$Q{L#Iq0oFa$4B}&S z3G*{Pu6i|Xg!K~g)B3lB2%}H94(i{&h+Iw8-n{8iDCl-;IiG7c@;zo8_$g=gq0(|E>nCwg=BT~AL8~)!e2qz zi-%G@k>RF!;}Cx+(%xDt3U>OA+#$oCA_guad-v_bEUu%-et+B`OnndXnHuf%lI2IP zM1_RP*U8A~mQrLEl!%mava|8eh{(pV&HJZr6}g_-U%1BRg=~8j=_1`nk=kx0>>lAK zvRqh5NM8DZOg9G@YuE>2;rWu^n1MH8B}wi?#tQ`^+1oQ}w>du(nMX5yRrll(*&c@M~|0lBLr>t8W}4 z^0@QeJ*S#QlzN`+^T_rzQS7TxIs1dpL@J-45m2Hf($JK5rdwzdX+o8gXDG@^{8LI( zBhrOP8+-yL*;k453FdHP6 zQhUB_5yfnr4z(F15cyMPWtS3di8Pl+5~!y4!;hZ7w+1%E3F{LEjNv)fgym1^U)Xf% ziDaF-1uCQYhyo=-rT*{7h*DI4Mzf1{5fwj5dTV48iJBgl)LAK?5p~zvwP`*}5_NwZ zp;b^XAnHX?)7b4xB`SE&w&u=O^!bTze@mAkxB8P!QQG>z+kt@N`)?N1p zk(n`>cKhB}Lhbh(lN*v1MCOv4&9_qpVU()F@#xtxq~qvxG-4nl%=X09v5XK18*S2U zcUH%U)T|#~TG@CKInM3mQ7%X$j2@1!EgQEZGV7atTWkTMy4#GqSM+6~*6oEB*}vb2 znkjLdJ*NAK>ODizp=q>{qQLP=6jVLk9!}7c@LRa-ws_PETz_($djoN{=Nx* z$xJOrq;2$@wH7QUibm8#=mz!@rKhNWU2~i!ipOoovlEUJ#a9G#ew`~L@_$_Xpx50> z6tFM*&VB0!QPMs8>#12eqL^1U+uY#|qBzs<%LT_WiNZ}zcOTt(N#se6Zn|#&mhjif z{9D<(K*CTt9lBh*2g`BX=cb>jz{Es)4MUX$EXxJWugVJ{oABiYwrE9Uy{w1D2 z)W#hsd}>V(4PT+O6`@n>VoGkW7!m2cc5#krJVPGh zpC-xj8z|mVy!C1Q5OO{0H+dfX6KV2FM5FgjB1a%yire4{a!H>HI36^G>@>GM&Z|E~ zj$t{K4!Z-$%jrce+sTFEzwLVYIe($d_Te+;Z*QZFz_#e>NF++To?9avEkdc3VtQjc zTahL3c*k0)BVn%#69(e1ESL?!p!NTzV!?x4QQ-v zw|P)3V*lK^H;gDj8yMLXi6~VfG)JLpf^wOj9J1=4P;q~AIAgK^s?M2F1`$(H?L#K7 z^7H$sW)>k=+Z{@>%dJD+vH_*-npw#lvrr-OCqqRfIV!Rjw~ITdq1tW9r8VbIsG(ZZ zIbTwX>V(Z!>bQ@n+7ZliPD2GX4ipj!um3=`f`eJ|4(g~$pS8tOnTr}by8rga&Y^P4 z)vdC_p{RD+f{yHCFKXQ_Sl>$Ak2=0{=o&>77kFmabH;yWUR4;GLIG~ESOxL{_VN|}W)puMY z3pHj0HzM!apvF=`mEOZgs5!oPlJ@>i)O?{DlJLM6)iN%}k`)k9)$PxhRTm>vqnP^q zP3SwS^Jo}oiwdH~)=^^W*Gs7N?Uka`cm--JiCw?u^%>PWADNH;U_#X+%whZKiKuRz z9;)_J0#%FIYzNYrQ7-JG%dG5cl=V*L+(C8{rKa+D?~`S3tVR893!Zn6IQo;L<%*$ggj`{PogGWh)`ou7OF`c4dA(= ziz@r%)EYjNp$ebH2;~)CRQP&EM+`PlS!8$Xf_4F_*zZ|?Pp*W@;R+fu zMJ=dy?o)C>wi&AK*c-!r-4YcHIP5No=b)l|ovNNNiFZG*xy3G@fr^EDe|q0XR49D- zZ2ol?O8eidckm2DsU^L=Ec=>K-Z%B&^${IZu$BB4xmJL(o%f$*w@-zO5y)m13Z z>u7W;uN373?kiYF??Oq68x4#Ut|+;5>Th+H4$8ebG)#1IM>#UW-MnB@o@BNrlkpCs z%ql@ka_ln7T)ERGt#StyeKRPwACaL_UF?|p%_pd$$QQuWp@NEB#%n1eB>iwVOv38% zO_cwxEWLi<35t?Gi(^rLgzN*ePre0=As4@Gy#+TJ3V5yu#nAAhFgS+ls~tuTZMLl~ ze<`G7XWuPxZw?tPT1TS(#3Fm~Sdj4E4=B#CM?}x^JW5`zbV)bei&BA_7io#CD8aC= znQG_?3O;cEZCUDpylt|ZqdsLQVIQ*F^PnKgurHP!-IsxqJ+HRD6-S^%Z}OswXEur? zSe5#5yP$}=`+AflJ&H0~lkcDMMD7a-&NaIJr25slF8VkV#WVfveQ)Za;Mrs3zgOIm zqb#YoNyU(6u7DX2mm=*%z>obSwMm{Byz>GiU9mPZflA(S|@96=q~B;S>(M zI*x*lB{Ymo`6#g!N^Na(4MnzM#LN5+AY&jE&0*p!w8x1i4(Vw^H(!%$@yDHTS%$D$ zTxL)BePl#LzOfTIt0|v<;ktm#n;Vj{nKOiih7AScp(s??_1bpaWYWveRI6`*C}EDw3lIFT~;nep^fdm>x^FN-T; zLPRQqP3v0uG$OUXV{xLb7Ln#xj=8K}6Oned|L7WH7m+u2AoIPS0Fi}FV!=maFJa!7 zd6V(eP9n!q3TK*Pb|PaS_rsyxEkxFX#)+wDM`Tw{lDlkjh)DhC>eQVy213P}rzQKw zaYCD}_x{$DWx}xM^@xtM?L?Y^WOczFb|R;#3z2bBh{$G_>vQ?dYr?=^2ewle{}4G8 zSQV8!eHmCiJG-P&|=II@Nk`Qk&3Yqk6QF?+0N)KiOet z?k178{Ag%lFFldT;;}_R$Y;Ws{mk|k^^Zh);offRcUOq~ciIPo?s5>hZiLoYMT8Pr zDXE20Wq~LaU2NN;X-(vPoG`J{D@T-{Nh%B%drQ=~U431pbBw5cx$stJZV^%afZ(4F z>90gZAY0HiI7^hLw@3o)4sMk5fYXttWJlYqT7vcG#9;uA!%kbvGX{~D-e<0!p^|P?LJ@8p{ zwp5X91CrhNxDMUrg`bgX(L8REP&jm@$V1-?63?mMh_zjU_%U8J$!m!ajqNRNi(c?f z_(h3+b00)E5}npeRw44!wY>f1e2K(2;)jmOy!;O+m` zWVhQHc&oSnHQP!MBusw$;y!o{imp4*jPwD-gjy5W==~x7$nDFM#cv@_IoDPF>|==P zTk4Pt@`Nw%lN*%UXd$CQ)!IRW3JTN)$H~iN;TwO|u)uvrNR(aPbCf^>2_|Mgrv?Hb zgx{|6mNhkea32fLzyArM?^sE&mO4SA=cvVMQ77Aye*S8QLT-P_ zticD6+HkggJ&y-ssekc>y}JuhHlBC>N?eAgx3*;yiFY6*^&3j`7{S}x#7{pn79nnG zEH9Wd4^nk?9#}-WKx|C)(VlN2@FT~#b+)$z(izOnZB|yGWWUlNU0*&#uTYQIvF5_N zk;*dl3!IR8{mL$LA#KR33%|skz86ws0+(&h3c&YU`(=YpMLjG$N8Ru4`XT#zE7{fcQ!r)Ig7JU+4kV=mrXhN zaW#Ht4zE0vePEUvm9B=ai_9NsX_BE))aQbxSR8b^j;X%6$p{@%s{I2-e9$u`y{0$L z4du+Nxn}!5Kr<)*9&t$*s3#BqmM$v^J-v2+{k=1w;&G~Xj%y&4&%b;cplA&p!%ph5 zF=Wuonu2pj)1cq)gOq%{JN)uE^>VC?8QM?G^vdlKfIjb71VBI#Off(7L*N-PhF^+FVD%ewy8eE;pCB^vj>1PHu%KAUF^jHkU1Q zsa`@ssjQPiG9R?j(foZBssim-KMK*A#z5)IryJ8ZYv7v~PohFfH4NRERXFip5vII3 ztc!o`gW1-+x;KAp;di|F!@7EE7-S$15q~NMBUb(sZSB6$U-RI)d!t?YOHqy#KR4(B$ne}TnXrZ=zmy@rw7#T0w|CiiEv2W5XlI^(?p{ph#QaW_J4+A0y+Es6TO!V(~BPv!O}v2389Qy~64b|Kqo2KuVi&iu%K1NokZ&4x0?proULEV?HZMvhY! z?{F4|cK2^f?yrYoc!%0&qm!4QgD<)ycAp9~+ER9Q@kau&DJvl;u>_i)DALp2r-w$d zat@*8x7W@m5|wa_50%RM`&}AICpr* z7if?8J-12!3CcpARQvuu4J~EYvx8e+LFYRC^HPaqC>*6ClUa2EV#Y+i*SkE(qu_jU zkGKW(88Xui%z4lxxI6dNL>Bb=%TG1dv_T(R(^%luD(GvNyT5m626~U^9FRySgMrR3 zo*Je0P(L`5EcT5Inon#9eoj(^x`dB?icboGVAd~4E>#Zgd(KOyeAAAT{{5w4gclrs)`H|}bI zin6qkdl%!OM!)(-sBbwmsnm^ZA1;H&qCfW}Z+Ae$CBoW>eiG zj*5v;cWrs`t*s$6)RPH|Mc6>rz>}yiHF40eUwI+oYaO)qe+tU;&>`iq@k;D!3Zzt= zq(UZA$3wi)9*wy#A$f8$=(xz zs#777J9H)C*TuS^j_nO7wBO8b>NJ5LZ2XmjJ8nbtJL`3Ew^B$BxXIB)ZU*V{1Gduj z_aV`2;%JAiDWvE*$Nxy#1?d|fTV6eV0jY)esa_TAg&(IQ^688`A#40Rxr?F_e5T-+ z+0?g!FHzTY%9G3CbGEE(cH<6sQ6!ynSx6D$yJw%uR+K?XoHvbcSQ5MtT9AJ==M3?Y z-QWE64nmCA-W@F)`4B~)$^09o?e^cyja0IhD-~ zh<*Fcc>T~3@Z<0CdENH~BIEw{TR7)KY{5I`OutbGH@I2gz7Pc;uhEoxy|@ZNVM`*D zQ+)7xd(Vj@b_@`&*sdSEYX_t}%06UPcpZYMGbUAE-h;r0A!ut$18*rlylkF+3-4vQ z1@7&RfDbRb%Ae<-f~fnbFZ&MSP(1iA!U7tNc%oA9qJ4T-+p|*(klkhp(DdiUynj)6dTnp^n!q-h7;F` zNf3Ngbef5s5#qiC`Fc~_foLa+!TYH(5KQm9cJsU=1mC)_m8_iK^)z3We-hs>dN-YEUtJh0gc6P%vYUA%kS7IR` zPr!bESpxWc=2=st`wc$9KNu<$_#y21(fe&GE)Z0e6#P4v2tH1oiWx<7@Mhv@{ZM2N z`1$mHixhbcZwG~U>hR{md-97LqCft?`zLCHg2Dn2d$vMnMd=)bQqBjL?D2)SF&DJf z?SWI8U#t3QLqs+Nv~*j@Kll!T z=T>B+ltUp{Z})pblN^LTu)4eZtQCYCxscDe+=JLTd*7bgO?cu6%oRQ|EvgoS8X!HzzX!UVd98=5#%S$k!UzJoZ{b$n*9J zmNVLrO1b&!B-=N5&pOMbX`%?x+P^o#?G_xvBy`;w=xW^_N0m9gF3DnIibGSfS@;pm8aVRUo@{ekmb-ozHp(l-nY|`9qz%)C;0;6 zJYL*eJ+sZFbjlaT#e?(%7+ zT&PpO@W}8oH`F_YKM*-`13E7I?z_hR5>lNfykDgZKujMww=w-kXx^tBD}LV`+P+zH z+Ev;>)l-k9MUN1uUrX^(xpbU#{b-ZsPNDq03Jb0YMHla4l=ir1|12oCMOPDEs0ZCG|;Y$0N zp;c(Q%Z#56S|2N16YVGE$w0+w-JCCkeL2u9cZHdbW3Pd>^1pb zDh$NTTn5T08R&ekE8Xm!3ZwSZ1_Cm!(37C29eqI;8f+My2)`;}@Cwbxg7FV9T2+6e zpP>~df&?g>>aAgnHp4dL^?CU1sFrbCnF{*9un2{{x(B`XQp!wSPoQ6{#zRN=9t;?@W*uR%;76iP&vn%{~}oq3W64{1;n0$B4r0B3%RTC?a$OVdTJZU z-D?(IvELoK;+INYFN;9WEp1gT z3u?mMiy!&KLj8@BsNa=ep?waYWU%gpp%AWpGv?_qQM`4B!tN4`-q@upRCgZQBE#;; zZ{2}LiZ4}#L%;gAqm>BdA)AUh=UWXx3rISI=i(!a@vvP@A25QG$oNn(_0is0b zYtQ(4sITDsbZOWJzH6$cl`JF-RtB_WE)=cf;arj}!<#_7dULdx7zcK1<3Qf&+F&8J> zVG1qYU6g8ug&tZao>EPieR*%n_{BY#n*2Nwp(74+S1uUEy1s%@-_ufRy16iIA{cNs z?f?vT6L(;%3Uv8zDAo9D!B}ph{rrX~%pJUDe6F(K=!A!*Zo9`ajSVEVvr^)O$2hHdpQ0dGELjodBddHqarw+rG_{tk-y%SPua#9XDG%}-N%CG{yH;cLHVm=LBQ{U6VgfgH{!)o$@KS?i|GoHTsTpmVg{bJN_ z1w-2jxkDcFy3m|zck(vFLukJ1>lM7W0{RTq1ZslLz~IBvnr7^n29L zUhPgG=~bhXvG1QlP4Vp0#jSa0wBB!_J+=xxY(pG9o}@Ub;BLt?-UWRRVt5aj3_{P- z9H&sWPcX!ML#I}r4~94E^c$c1!l+XH$GIafprkHv`eCRfbeBK$IQ6awhR2M*9-W(k z{$dp!3ch2|T3Y%fzrP)Rr=?~%hxd@`$Hz@E@gf))xOU9x>NV(-IQUlX=nLp$PP1gM z{|=o`x613CN&CyaooH=P4UKZozfWupK>FmK!BaXOK+u&=zw-SMq)hzX*XO|t#T3R_ zN(6Z*3JxCs%)|hNPi|(=dALFPgItW<+y!yBoT2k*G!zP@sTUR5LF0kBwe+%VRB=A|qTO-;QspH!wn;js$W^laWRy766MpSc9=Cv&*HpTk89JnMcD>|d#sfWJ zscumNw$ONdip4+C2RiS@O$1WqQc{W&Vp> zwUg8twWlkY@HnTjaxg_$3oDK$5?0y;wp>y70`- zIRym>dGy#ifl?H5d~4>zCw{`O?|V${km^>ZP8K!44jbg1$3Jlos-Z~tL<%)$G8DD% zic>6*hSJnIx}f|@sA<;jPUS0rG_jRb5n6sACKucZ*!cibZ>0X*e7+xID5W_Lkoe8} zPh|=bIwam%Ha>7t!W_Qk?x*q#5Qie7_0I^~M^M3Tef-pHGE@Y#|JEpNfOMs=xvm6z z`0je`&my%le7*}=%G|3j z1X15rGdT!;k(k_L#m_h<;xi z?slvk-kPtlRIW%vq>QOri_;bOls-qkhP04i%hoC7ybltmvchSs9ztB$Jb(4nYw#}{ z=t}3Jfas)|fR!#g_@*T;>h5L?3EMJ116a!-tbs-85K|g_{`THoYcmcam!E|BM}|P8 zewO~N)4QZ9?i7;WJBrjojrah}NP}mKiXD z$TLz0XtMxPOz8sPpuG2hMZ}`U-nmn;ICrl5u0^; z|=pZ?yLp-8E1=X6;qhU|a&0lOK(vAp~G@K^gAv2o?>{~1Td&5F5AT~lNZ z7L5MQ`{zG)M09J-H)SKE&ZZf21nWQJ`;Rl8Ypb**8V?qLQJrCjx2Q}upFhU{aq|HnxW}vd+d&n zlBlR*-@Gc&i+t6)-t@GXBVFbDx=`a`6xJ{aIj!^o{%YM;x^~n9oYH+tZLb=S z@1!_Cy3qgUKzr{0)lQ^2cQrBGq7@m=pe6m=Zm^59Vq3j&<$v4f|MIhUT}4P(s0dug z3+n~by}*Jh<+`)>dl20-lNws&VKga`EBGgW0W6r`Q-q|C!_m}<&{t(ez}j%m_p&JKbqJg~WG$pkY?xj%=d52GB}q10Q{-AGr*X?eL`z-TLvtp|Mc!L{y4 z{F;U>?20aULwV`tf6tdPb~I8*6e`>fZMSuLAs+?JR#^l!3Y=L}=YMRC9H(t9dXMu! zPKv9g-uxNlJJptYU3(QqPR0tJ`7QUK^Rqlx9!Men&o#0PSu`z-A=eq%rTx!-K}GU8 zt5+Y_0Yk?Oo(+Ec&wEh;ON%k3$Wmzxj{+p)-GC_nZQS==yt~ zI>LeJ$rbU5n7#kZ=Wupkt4~_ufBAWukuo8?xgI8~9Cw~h5Bg`kiSJ<9vClRCT-(U{ zXO6xPfI)@X_lKi?ft6Wm-NJ0$|7MR-pUHq!>RA)eay-uS^)EGSo%PNRbSU`c(%fp9Tb&;bccf|0b-#`8^oW3^}SE&g(0q!jg2d~4Rk=RH4P4Ult zVa+2l4~HA!uSTrfuKjeR`K{|MqQgmtYQ13hqIXc*4p~^xwkzifxBsu_j<*{u z-jkyt-JccJKPUty+5+l7C*}XSKTFdPdxicS(oxdKm#y_e&dq9S6&_Y-f;-s@&vgIs zk2|oIQo%RyKyKo)R+`64`&b6 zXQ5!oBhHbLhtNCw`hku7JW7*^?QBVY4Y}HSE4OynLQd`zirX5L(4?#J<@4wbT#abXAIC?e{dyr6SMH4xn%{U%FF$}mJ(1EH5i*piu2re(_kkwm zk6&EP9HAo5fu4)97d15Z{#E0<0Nb0KpHYb(se_h(yA*DrNVS0>|B+LWg~*}Nz9ne0xkYaXahCX-WkKLb{_R^pB6OrUoyh~w$s zAQ(BiF?-TR2TX^D7j_@r1wyRmd$(Pq|0`a0<(cpet^9DVqnWA?HxPS9?J_*geWJn+mf><_`;|>$ZuID>bBJ{h|^o z(zbr;+z*A3i)s`WStsE{{n$C>lHdQVt7oB`VJFA&pSXWrct}fi7VM&EG)Dfg{IB_8 zFij}PxaIZFHRTOG@(a)Y`?m>-+a`!hg+^6SP`QX1fP+&atzl`j|k+Cvo?Nb$O7rc@2=>{B}u4AJlOELTMH_lDtAgR$dKYQ zyxV~M1ynq*e7dEqh_qTNBdxzl{3C>r*Z!#;#mO`#RxXMnr6x65T*WGM1mF3!Hn9zh z6_OX}W!(Nb7w!<(w#mRts6|E=Y8PLE3~rZy5DWWYl`Jt!Q1A#+hrJa^YX`__o!xtq zE&`=OOfWq3JsMZHcZ(85k&IHgI(E-<=!ke=%cKm*LuPKbNfC}zo6BgQ{bO_jnqHS?r1%K z336(7yX{UrNYZh`J05eSfDQTe*z$@N*w?76G&J1_gFAnFl6iF_<@SliCecXbBQp|r zw>t*oVeIO%E{`DRWxgm!Kr!rzzA2)odHWyx2lXSqNRGH4IIBM0Ljeb$9tULzZs!SdRyD@kYJ0=wxOSUzih9hGvB zIdoEH&S(KPDqh)?AAW=E8o^&4@2-Xsr}J4{(!L}zz5!gVGcQVS zRQ#`bS>Y?f<$qa?)Mp|hE?wLKgLt*7)0qY;?rgQv`rH9K*1V@C_F~|2q-xTJxsEjd zp^TV@R%F)_Y4{ZI3YvCZH0XCWgPe@U7xnD+qRZZzMV}c`3m5mh-i1RwO=s{atILT{J9K^`ES{%#ZA0yL&8S3XwYe5nZdj zIqY;ve{R;v{m=Wo+i@v3OTIzQC>48MzB3#-V0d~#G@cX}a?w7+6wo`r;eEc88rH&> z`|V#OAX~NY(BpG&VNl1i%&s(%)NdHB{~Y5d#d}8Em1lR5Q~kJ2vwsB~7VS~rmp$;$ zItPrzKKqGfAyt)FT#A}6>HN<~E<8^{el0(zV`-7lM-iR4v={;-hl>Q$o2OxxiYQcY zxej`_1`j-hG&uHw?p2@s7K}%ldk(~&{AXSh^_wX#*jSOSh62ar!eRN$Lq?IrqyKAs zGzkx!{@DJXb5hO!#IUKU_)lK3k?lL+;~ENoap0HEId16i6a5k9@K3zKEOq&pxyz&f zTpJWHxQe|z0{eFBM{Mp>gN@46k*LdRC>VOHrO*2&Y+ag7e;?!lCrdx3@AP;925tw9 zo9zNg&y(jI{@eP0wU5N#-+zyhK8xfL%|0P{l0IG@KapFLS>nxG#{aU5U89wT(Rum*TpLZ9>9PpC zJOC%T>{rs+PQmFD@)22geEw^{?Ukeb^~9DzXlL=m^X(jPBunLJsp$SR3Z zUEX*6P@o;0Jfm*9pnn$G)uzVp&|f3zx;tu7cgm4F?2$De#Z44A6-0bTzaQ2<&JAon ze-2Hmut5BhgtVH!bUY`5NjlG%+ox{^7VC{QW!PoF)HWl#1Fph&+=DT>}} zKJp*CPORs@i)YLL^Bm5z$Ft)88JC*xo~XMSj*?o6CyS$Kp~Cyx%pq~d|23Wttu0X| zJ?ckw8@0>hVwX`kbi^YxH3J1ToM-K*{ZT?AX7S3}7v$Bv_O_L8FG+{iTs?NN33?aP zgl--?3&)4qraKP{&~;NU$)dnMdL5&1cP4CZnNBXMOy?+9?n!=D17^mUpc8s1ClP%|HQ52_S|yF zt`W$w(0)0t@(QdUk#lWaqx|Q-P-We+uU{wN-OlUuYa9RDIg|Jg$Jz65?n2Ik`p_@s z5~yjNB*$&NghFR`^ZGp)hl(OgHwKYaXxh=0kip6TM^NCbdhjV>GSy znOqOJ>@hoP@HNAz-XdpuuN@;SHuAnqb9_bW_kY_JN$=%!%hOLDz5XA60s=apj5>dkVS855MK7=0}AZdgEb}b=)PR z{r8FaI49JAN@s=yZ+txfIa^-CV$uFU z_wlTihb<@MR6)|Y>}AOLe1P-N`ThTuM@_PZgI^=sppTNE&&bRCU-vu0cx}FfGa(g) z+N+MPaU`qV(cf~U6%1C0GbcEuAt$)-@ZG~Ar2Nu*X_>l=JZBB}NH3?sc({AX$&2d$ z_$_h9Uz9*i(ksptYRq5gk&Nts$o;3|$fz;)Cx)PeJk>I%8sE<%&Dq=ikJhS4^`_AC zXoM^L)od}^Fj9ez7>Av$L6@LnRCP))!vF>~FH$RpoQILqzYPL@+e05!s|Hni66Aao z6%*jK2IF`9#(w)+|Kmr(lZ8{2?EhR_XW4tbuD=D67nnYnRUP@yekkotqkgvt%dS=8 zHy`aF@lunXv?)ti&@*=}ld(bdGtLT`M>bI3MyP8tg@{zOz{+`F3@Sp2ZE-yD|IA}@ zJbH0jUF1LOe+iiCi~K<9^Sy0j`v2$`qZ$2)J;lMvNLABVqPh4_{f9xh)ENWA=!&<*E*_807fy}ylgk@{xb4g)_IM(ACbeV)WZ zi|pEA9)*jD{2F)SZa#L0j_)!Bfjxe(S2Nnx#K#9PiurG*7m4@X7}vho{ET$IdaIX= zRAErvopn|CI*E7F(cQSj3c1WFoy+Sc|M4fV^3(-WH+m`KbZaoa;4XeGs zI-&@H)hFGS2Ff9SAN#SuU=b*Ied)vqSvS-Pyg#qNA_axj`$WBzo)Pf!3b|z! zr&8jrAa88qcK)6qc$PV-F*9-xK0{@aM8FC7vEwL*A6qlzK679bzbr~H)9enAe?SL( zj22ObqYjV~*%R;acpcK`UEK~%2S82m;_GNVK4@^tvG)o64C#7OI!ao-P?_+A|9xgV zR3E$xT4g^H!{y7v)u(M)0KGR+0csbNju#f3g?5URqpN{s z(4o)##`#<*w06lx>`-KaQP)WMD2GSTd&($khVc;$k22hAE^&uGuAEewAy@bvKG}TG zh82dUZyq0!C#`Fo+#>MY9%?7l{OwrNpug7kXpG$!40VpuWz^k-A&&eLtY2?J|LW!4 z$GiKWZQ%a*FA{z5XSc92-A-p{UAH%+7$dDGJu_O_G!GN)4?53Q4#C79`oxZ@6c`Oi zy;J|&6ejJdOh1wh!Q9kf+MUT?usPZ#UALf)WWh35$mVlk`Y2b{pSK~fICb#VLzQHt zROAWpaMOnsqk0$LA7_x3TCeZ?M4)gA*s=j~u^r^_bbS9#BMS1 z!Vlyan>}40Z-#6&omsa>FCfG7CVn;JV%UH&O|!gu=8@vt~BpPPF0t| z&Lvu8vp?f`$0z`~qxwgP@$AU8Pthpi#u;R`m07;PbrL!9G;hBzJA>@zhV0g~7RZ?F z9XCAw7}-CXt4HSf8x}yG zzRg4%BU=MfaZ3b+HABtrT<$?J{u}8Rt7}ozb|att_Zt*rzxeji)&`1? zFdM7H@uLJ~LY!00c@*uW_#NoykHTSn&iSF+C{D4%R&^4|JT{qC_+(K-1YGLxLqib;&`)*_!lJ<4p%?h z^%^CJ*bpUCOiQRt~?Eq8JRifJCzoXK%Tai^6%c#Z}6C6>khnCGBa zLEHzaF@BVmAFU}VNJ5?t9l?_}LCCFl>r<4$dz89iNqL*w4k;{JY|Ueek>4hnY*XAD zC2yRJkmvPBp_ZfWYZlBXEwy!{_p=HLQ+GYRD)SnJpYgXvuuY=CDJ;wVt%X7jp}c7W znJ8A{HW=erCIo&f~V|=IQz0D0b&4`%u3OinHYUrJou@u>-|C;{xj_@apIn zr_B}=?)t`b5oVxUal- z&(%UspNJj3GR(-gb@kJ2UTUO@{wm5_wiCI_R!5)rl_9sza^EWX5oDXDN>Z5PLe9OO z#srqP$j-LsHLr9Ta-ADcO?lRc9AUNWn*-O8ombU4V0|0esy}y?+#?`+%jx8AOD~cA z6}#{_gdtT!h3>qf1hW0)50Yi}Ko*BE`n5j+$kfnj^UHc3nH)Oz@t9a5UAA{Twf041 zF{Wx=Y<++j?%k5!hs+fFeiyUtLTY{%%5xOG zFk{ki$)k7`hQ)`EB%HbmD=lsvgnNasV*859_wF;KJ2)2d=x#i$o_teGl}3v+&sNp$ ze~pFZVc96!YsX<$C&I7wKEhaeeZb*|g0NtCZ9MhDPMBL7aoiK|2^PY4PUy>R!&toH z!}16Ur1G6SVYlxBtnfYIB?cday&r=xz{gM>tac8@H7VWFzwdzA+M{3El?7ogVWuQRUIBV%DMWk;{?Na$UzTTL z8rt)AzqVI?4WsARJwlCFVfGFjzBdmnp~(4dJKH z&(EHK`d!mJuRN~8&skAB3Wc*!9JKeP-G^$ZUq8;@GUN=Mx94=xnr%=jF4SD zAZ_)h*Ksto0-ydT+Fa z&2Me^{4D0w!SjD0UV0CDJBh&eP5m5IGIogBHg~A=ScTMwH3o;mHX!vz%g2}H29W<% z(6g@X7GyS`{gqTtfVB3|{XL#SQ0>ssH~jJo6xzBTnEt*FRXf#o4o`$b9u;TTbH1JM zZj6=K)i4fU$i*3N?5`wT<2#Zw6I=)}>96+p*R>J^U#IJ@i5-XC6=d)B^kxyPg!k+2 zT@-*Hua}!Q9T^}hNT4=YPM=^hl(S8<+XXBV=#u(1~dzlYFsh@esu z@-RqY2pn{i_r7Fkfqf@JOW4X&AmX;pk2BJ_koO}c=CMH`7FzgC3_c>$0~&mMen>?vfuz40dG%?>F05OnO=(FlSa1ryTnM>S7dkK-UPqg@?ItUMh*zB`d*dgA)HB0tE7wqGH_G5?Z zGUU8*;qu*~4R>p7tF!0cLx=-I`||h*+|sXbSRMUH2#gY6pe`B!*OIU;Iah1&?f>aG zTm2ex*B&}2+dLqc?!P2|YIqim*B35EKY2>fRwt9Ie6m}Z}-6a&j>a>wkSyx1vN zj&MXJgVM~h6TWM0U3jDE1mVsFcRU{7gXe}P*e*=m1^1bE2K9bqU^}qGR=}JbK40^r z4~Ytg*SCh3^_;EXzG35zulX0i&fZ>bfQ*4)l90bDml6Zc78Fv#vb!L&_!GC`4o66O zNt6yM?u0~^w93d+%#d+cpY3mj8svJ9ChULIPl!&qE$ElM6AIrxX&X&7g~;)Ft((Pb z@YC(m2*2@DND-oblwTpEtFnF!HOJ2| z&)!^v>V?xi?ZqU$FmPttg7zv9?y4H%gHC7|sOpSanudD6)}(HGDrkKiu;qAR5Nc}o zaZ4r|LNjyQ!)ARg$aPB%<%MLD7e6|Vi@{&+-erxeKagpb z$%-*a51HF7{0_g-LrPDx3L#NJWIt{?I)A1YS??v4X?{~ers~5FGgW1gJ%B7EexEsV z3Vv^ERBA)E?stQE6PItcQY2L^5V#Mx$WyX+M%drsaeg@XcXq3$C4aImP8SDLEWX9W)!J^Hx$?R9>v}qq#7adQZYtOC2A`@ln~4e^C}KQ zvHlIm4kJgDm`h5o>mNr6*=Y6n%U?)5{wdh&YLIyLo;_1@ekdBj_SsBg3`P4RU*BK9 zh+=-eWEz^^QG7q$O6*`Cig{m{^hzNj&)>N(XYX;Lm|>}}?N%U4h)DP6$3901!{|31 zsigTS$ZGd!<)e_ib$3DY3lwwuLx12=GzwLpePihO0wo0If*$(!p~OZ1ze98TP>QBb zDsc5D((PI6d8h0XIq#Vv1$e6f~k7R?+e%G!D@y2lTN_lxOJ-t9+W;S(XB zJxF@Yw71S#zmjB6Qc}hu8H&37iQ4VTMaU@-@F3zO zN%xdng!A3tN46x}V`kf=x@GM!knOQW;>+q5&K_&Xaa(%Tbn+c(ei4bRKOM;NGqdF^ zn+39C-iGmsNo4LDBwKu|jO>>Rl|ybx!6x@}KdJ-!kkyklP4T1~QV;bey&N<_I`NcK zt-l13?!@Vv5A;2ejDw~~@@o*%xp!$sd2u6+eGq40%4MW4UDYUq1nch&M*Vdj!iu;neZ03b%#!EzJXqTe1HdVfcZCzC9xRM1J$nj^ zbRqm{;0ja6zecoajKdgQd_@RjM>4CMb*qu5kW6LW)O%wmOwrwZnW4i3 z!*L%Ix>zp31}F20SNA<&O?Uk9r~SWSF|5VbBS{KY!9~+*ISf|M6j1GH{|Iy0WZDNZ z!(rg@{l^w(#bN4kSWChURjA$&pyb}Ff`)Z|iQDTF(0^g-fwO2JjI+%7sUF{gx;ouH z4x8)HD%4)!+{*;*i}S?5Q?u}g`ijtl6&aY-uHUC&8xLdOUwmbDdkUjR=Hn7%*x)I( z$MA#cLHNmgmo4E3Kja59+!SSs03Y|KgFY{ILY4iG>^|y97+Un#Wz;$XqfhqhmmK$i z9M3BKUn@OOUh&$!C*lB9#JBcw@vA|F<#Fq9m&Z^RX!<3b*bgn=-aAKFwgB;662bP9 z3EciFX>q`z2vVlfkAKYKCD=Fy1s!VkhwyVDEZ1hj!1?Xvtt*n5@Gd)R_2<*~@cm`p zEw3hX$k?Q_bvQ){9}4xZ@v1sNWX$g&y4Wp9Dp(I*7u*Z)24+MP4vi3e{HsC}kNtr- zCpU4z6Jy|Kp1!0RuTMB2Ke<17&J@yYYldzJzJUWWG!JUB4npXYdj!pMIp80cRbP1O z2jOsvidqj_3E0|mpZwCjhoBikB`#(@4FSxaqmmI9Adq+T>A~)Ogu@K?%jXvepjB>n zc%MUyQ6F6z#ls^r1bz3+3kR4b38|qRhxr!#Kifo@kAzp;G8R;6s)2Edw%Ou&u`Fz1M6c01#4}B!6mZc zoY$s68J9q|4uk)E*Z!utY0haY4JkANXHU6Zg~V0G`?t6I2uDBt?bVk0LU<`DD^}3* znh-rLBwSEQMo8J>7W0uVB&4{WJKkY;obWJgnLCoJoe)@6d~v+abAPSXCaNrm(++El3tNFt z-*&zHn&(V-N?!WwLi`-TSA*uTWBMI}*MgGUa7!b+^Q7Kk=#&S^41QM<8O7mKtjuv7 zW+ue3uAe@6$e9phl4noT-bV1XgWA#VMHz^_adGtXOEOY? z>yXLI8$*Cx;W;%|Zip#svRZyL0I{1>L5ZQckmh@rJ}Sf(vOZ=->~89XFEk7qOoGdV z=s_}ycS=$ax2$~Lyh9ffD{0Bnp0`6ZS!bEYPaF7L`ib?!nExNpa3pH~=Os{iKLVe|8dHOzos8UhOj-ITB zvU=4x_p>!np2=??Ai4w%tc=N;rQ*>3-hQv?U>rPt5ynHldk``Y#$0kf5eLLatPM=% z524{>ygdCC0jMSN379xZK^a-6S3~X>!mCIN$IR-V@S9FVjeeEH% zevrp76oxvhTaS?HU)G5?T7$Zmq2;h*$)i;v=-bt7_+IZdG`unr6K*Mm<}q?Qqnqo{ zuJvA3#E%??y7^ykxgUmsdk-q@c}=0)&z+OVR)o&j@31((i;mBND4{8EkqHOzi= z7XCV%1!LF788XJCU~#D-{PQLmEIuqR390`I(|gj->dSqGHCnc`1>+7_ZD=ZVSUj(@t)bXFyA>_4=6@vq8l&#XVE?6PimEe5eKc8Up zhr!P@6K+`c%GgDzpATyZujIB2$zV;Db8>7w7urT@lb-)sft3eW7*}!>kgUG!!ohGg zSQ9p!b}U?jO)b;!4bDBVvbbeGtaBMwBG-CeS_VPAROCC88d~TV30El>dkhl=aYgl} zYcS)BXK}#PbfVPC0BKeec~ncL3>MPLMO!IYaYJw{RLU zgoWLII)Y!m>9Al}kEaSe z8NdRY9%UAbwH!#{Ec{{ivH{ZkTC#e3#}sKciVq!26M>C~GipCx$s?^vx9mP$M>EWP@doJ z25Y;gD=sV#!Q8WIBE`^4*xsD2it3j@at&?)C&zfCaVn(TsrUR$Y9wq3n|0Mt-Gx;x@$-|93Sl|JQ?u)(FH8mXsdv4x*LZZ1}^a>ImI`kX(k+Z1+PnX`xG zu`kx2{+Pi0!(YccPwj#Qo-S9s@CO#-Dg>RQ)?rD|x{XiO8WuPiz0bOa!~AYy-S&=) zu%MYaC%kS6GZozS*-d6pI~JRI)M5ZN|m8!#(a`OE7?ItTwpo361 zR69{z|KUppMUlR*L(ZIr-nWef(;3Ooqsr0SoVWrlj9gDHCX_+b8TC>19hH!NeYe0v zc@~JS9pS3jW{1{~(P%IF2Ff2B*Cu>!f`a`sMHHGlp#F~2cA$kClwCWctw^H{t!$YK zG|g|Ip7pxukk1AXz30}M8byHs+#g2TPC~-8_gl=qL~P`C%=7NvfES6L0k>czdkCG((2 z-=R<6QXC2&PwQy^eF6DWS-rQ;mk`1>d#vBAUIptmnlav86_Bm;#^KScD9G)+$Hn@H z9Mby#+~QfFh4|TsYRQlo$Tr^5*|Ne1IV&5=HaFd%q*vsUO?4rOA2bGXoVg11JBBAB z(|sUyb`O0u!3pwh^&0cI#35$~Lx0ikkMOh5@^aDBN03|2SSPio1qydIUN{mQ3j_fv zwOxc(NOO^~9#H6knPM*>aD50ZKx>a!lo#f%q&uQJ^Le zij)l>cwC!=3^%Xwm>+fUGrj43+i`D5kg^>aC)a|U!UMV3S`N9#y$9CMCBt`{!TSbh zjUiQ0E%+O)6C?$G>xdUpgRkiqcdyG9KnTZ)S>M!igfBi;zpP9y5EAqEuk3YABqSbq zAku2KO!)HUioo3m6Yxb}+)9@i2p@O8iall$1<6%HMuNfDNW4Mczx0#>WPW~dbN%%s zln%!p)JbuMGWw3Ef=^5!wl)r0SeRC2C>9C$&&8~w}pH2gZazk@$s9I`TmW6Jv`1wgWC(OSWqJt+z_63VWq(|gFKAD@4uZ_XG{hvc_@fVB5)8TKd^6BPfztAOQ82?(l#c&Ct0%hg@hIJE;MKehSNne1_ya&q{j*mmO%H_57 zD{;`kd;=CAC_%k|wpG~rC=@A%IJ3uu!Y|rj!RhlCq3Br(i{bEHC`vbbWH7WFN-xn0 zXk~wbdf&kq29Yz+_;bwNg3TN9bf0yrJ$w%hmUq%Tyhfn>iHo(b;3ib3ez@!=k`KL8 z{<3FYFGC&s=9B!qb*Py%JxXt83?(eIJT(f}peQlZaUg{qh{>VRPlsfoMs$5ymFyFg z=&gOd*4Yj1Sk_sEdW9Ms2}w`JC( zKyK;bE-lk47|*6DzH9Xme#2?H?+>b=%x2OqigFVgpG-Lyu;xO;grR4xzdzLec2<6+ z^cvb^C<1of*a;1 z^_g2k(IevL!io#fzW0J5<;Ov2)c?jb&?OCRaQ>*1L?^GyplF%I0{ftPMx8wG@z(wKtM-8xzXym9a1uo-?kH&L|PZ~7qfo{VQc3N-aS#zkzAS}-!pLq$@6vR#gro8 zZ`wq6xgCkeJmfU^Eg^(d2boov#38Wr9#z+bfe+@<;ZYngQE|{H#>olhRM`h( zJOL(R+-M9_f|34&Z^pU4ab!GpTQJw*HZtoN#rN{RK_=tlLYrNmk&fe2ghJ#kq*L{_ zY>wPQrrX5@c12!Dd+qMYS6MVj)unKYJF6U7HSgB@TBjr9&GzGQqT$GrET2Ss;yKbw zKCGhLEsP8d9?x^r5Lr~mnjWQPBg=!O{>4f*k{Gwa)-&*NM2CbilA7-v1 z<69Q?;{E%Ot|eFZUR5-bDZjIS^h6lx3t86!#Kw@!solccj{k7AYRmM%vd4l7X%xNb5P^;MmxS^tYZj z-hN$)OkeYRJuU7a6Mctp@csd$U2F^M(_({d#Ul(WK39=d%5~naeh?WjN%;A@7sw#^ zskYzQ3mIvt)952CkwW~r$JxTaNMk?sEUA-ZpOxyF_JB^LZhRa2UHci*{8V(zuoOWu z;=^yx#H)~w-DG)zEgaSwIZpg~r+`!%40Bp44oGfOopTMRkvg6$(5{~y=?pB)HBK=j zWsysxz#1n~KTGTJ3s*#@fR`WDwRDk=R`Vg5FhA1H@5@*8k%7LC`|K#@FTmDlkNUHF zqcd_7uzW03>MbV`$*(zo9*iKulIixs;Tz|X=40)Xw`RJquF9fN z$dwBV6ve}b$(UiA=ZD_2yw|X*>+Kw&+(6=~RrkyKPeXl%&P3p0#vBrB&e`V7-Zfcdu4-bMvqPkYx%;xYR}Po4Y1hU$7i%b%`&7$X z2m4Mb5m6|q5Nn6roOCjdE}ZB4qHEW+|KMDgA0Fh}mFs)a^V9XsXC`gYTjQ?Itn^9L>X5Tnx8LiawXc5YaW3(amY(tQnSO1&*7lga$SbL{RtK~? zP~I&_Yu@M?zdda`uamvolx%9DRiBjk49l$1%gNVWZcf{$Ro@I>f4E?dRvpNS*cbJ# z7I@6f@T=LQWwi%BE6D#v&$%p)DdZeFpFSdKL9Z9}bg9Q3_qVIGWbp1CUF-g+Cw(hB z&KW#U^ShV+?Ll3Q9!pu(dgXxLT9j8eDA(Ili;6z-_Fi^gk6a4AyuNd?mdz_4*1ou( zmTy|(dHzI=mW}LtE^*I(JyNv1sMr0mdSO?5hj9%RdN$)oP{GpHnqTXAyg0pFk1zWC zx#Yl~^-P8Tm5kInJ=o{?^ll9=Xx^}s9WQoVtK|u^LT8`3q6LnG@JyNqx+hw6_L7RC&H_9e})82V1?@FYDPJbHHV zeck<2k_Q05ag~`VpiNY6`9gD>Zrx0qPG_24S?bEbTU~10GR#>U56q=vzPA+9)U4ax zI$wws)SQKs_H+wDfe1TaFeQf}AU>%z-eiK73eWljHt+NE_iy-0L&+RgcFnmXY^wS+ zyx4k!Vx5z>C(9NE#lr@i;qvsKWc8#Li+prV-ujO06o+<~xAuI|eIK6f&gjYX;PY*R z&DsF_+(}d2-veq>ieez4xsPUP?<)W2Ipx^tSaa^-W}_=EJg(n%YJb>clPGPo`i*hJ zwZh-fhi6zjFb@XHG6_k5-jiG0drQ&80}7R&h5*qW8&lzv1!HU z+FJOmgAeA5Yy}iJ&uUV=V6W>wD`aM}iNydvRl9FkBI%%)WwtP#L0*opBb7_3?>t|v z5hBJ&h3t6iYe-)*zX!bW+L@J5HU$aGKg5)y$*$5L?f2>$vHn9aL|`q zf8AbXn;EFxg?hT<12Gt^7KJJJI*^aO8m6$>#UHvW-@h^o!`x_6zTrnjVx6Ia@1pG9 zS$Us37OyP)sPS{fwyX%CZ<5v-l;s%&AyR}VQpEYAmk?lE7!o)Ci6TejH%d3`9g{kJ z`6Td3pnDyu#P2BAikPj8{b~doB4!Uo#tRaH z1W7)?(gobA*eHS>@tZZ3!-?+hA7hKYK`EmjhP1M{FqDe|o6@%{6Ju)wy&x|$p7Y&-0o)k`TEz{*IKQ zpf*tKvvkUcDggnQptyiJEz3g3RoUtPOM{hWQ)PB37Z40i>HslsY z(kBN0TRKb_*9V_l{VjasS(EM6sC_WHPo*F5!INWJR9%VqrZeW1n?gimKt39Mal_m~ z)jDGQ8$23O=+e!csZ?o|8PgRdID4ih6Eb1_mvt^tXg4$?l9~hYw$b5r^f5&EyJ@!-|yMtIkS94L=k$}Kwa>Ta^;ybBI~d)y*~9dZ+UNy%ad GhkpT-awyXP literal 0 HcmV?d00001 diff --git a/man/PRELES.Rd b/man/PRELES.Rd new file mode 100644 index 0000000..8ad07ec --- /dev/null +++ b/man/PRELES.Rd @@ -0,0 +1,140 @@ +\name{PRELES} +\alias{PRELES} +\alias{preles} +\alias{Preles} +\title{A simple semi-empirical ecosystem carbon and water balance model. +} +\description{The model predicts gross primary production and evapotranpiration (and soil water balance) based on embedded empirical relationships and basic meteorological inputs. +} +\usage{ + PRELES(PAR, TAir, VPD, Precip, CO2, fAPAR, + GPPmeas = NA, ETmeas = NA, SWmeas = NA, + p = rep(NA, 30), DOY = NA, LOGFLAG = 0, control = 0, + returncols = c("GPP", "ET", "SW")) +} +\arguments{ + \item{PAR}{A numeric vector of daily sums of photosynthetically active radiation, mmol/m2. } + \item{TAir}{A numeric vector of daily mean temperature, degrees C. } + \item{VPD}{A numeric vector of daily mean vapour pressure deficits} + \item{Precip}{A numeric vector of daily rainfall, mm} + \item{CO2}{A numeric vector of air CO2} + \item{fAPAR}{A numeric vector of fractions of absorbed PAR by the canopy, 0-1 unitless} + + + ## OPTIONAL FOR BYPASSING PREDICTION. FOR DEVELOPMENT ONLY + \item{GPPmeas}{NA} + \item{ETmeas}{NA} + \item{SWmeas}{NA} + + + \item{p}{parameter vector of length 30. If parameter has value NA it is replaced with a default corresponding to Hyytiälä calibration. Vector p has following defaults: + + ## SITE AND SOIL RELATED + soildepth = 413.0, ## 1 soildepth + Effective field capacity = 0.450, ## 2 ThetaFC + Permanent wilting point = 0.118, ## 3 ThetaPWP + Drainage delay = 3 days, ## 4 tauDrainage + + ## GPP_MODEL_PARAMETERS + LUE = 0.748018, ## 5 betaGPP + tauGPP = 13.23383, ## 6 tauGPP + S0GPP = -3.9657867, ## 7 S0GPP + SmaxGPP = 18.76696, ## 8 SmaxGPP + kappaGPP = -0.130473, ## 9 kappaGPP + gammaGPP = 0.034459, ## 10 gammaGPP + soilthresGPP = 0.450828, ## 11 soilthresGPP + cmCO2 = 2000, ## 12 cmCO2 + ckappa = 0.4, ## 13 ckappaCO2 + ## EVAPOTRANSPIRATION_PARAMETERS + transpiration efficiency = 0.324463, ## 14 betaET + kappaET = 0.874151, ## 15 kappaET + chiET = 0.075601, ## 16 chiET + soilthresET = 0.541605, ## 17 soilthresET + nuET = 0.273584, ## 18 nu ET + ## SNOW_RAIN_PARAMETERS + Metlcoeff = 1.2, ## 19 Meltcoef + I_0 = 0.33, ## 20 I_0 + CWmax = 4.970496, ## 21 CWmax, i.e. max canopy water + SnowThreshold = 0, ## 22 SnowThreshold, + T_0 = 0, ## 23 T_0, + ## Initialisation + SWinit = 200, ## 24 SWinit, ## START INITIALISATION PARAMETERS + CWinit = 0, ## 25 CWinit, ## Canopy water + SOGinit = 0, ## 26 SOGinit, ## Snow on Ground + Sinit = 20, ## 27 Sinit ##CWmax + t0 = -999, ## t0 fPheno_start_date_Tsum_accumulation; conif -999, for birch 57 + tcrit = -999, ## tcrit, fPheno_start_date_Tsum_Tthreshold, 1.5 birch + tsumcrit = -999 ##tsumcrit, fPheno_budburst_Tsum, 134 birch + + + + } + + + + \item{DOY}{Day of year integer vector. Needed for the prediction of deciduous species phenology. If DOY is not provided and deciduous species phenology parameters are not set to -999, it is assumed that the first values of all input vectors are from 1st Jan, and year has 365 day.} + + \item{LOGFLAG}{levels 0 (default), 1, 2. Generates increasing logging to preles.log file in the run directory.} + + \item{control}{ + Parameter that selects the transpiration model. Equals etmodel in c-code. + + if (etmodel == 0) + et = D * ET_par.beta*A/pow(D, ET_par.kappa) * + pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + fCO2mean + // Mean effect of CO2 on transpiration + ET_par.chi * s / (s + psychom) * (1-fAPAR) * fWsub * ppfd; + + if (etmodel == 1) + et = D * ET_par.beta*A/pow(D, ET_par.kappa) * + pow(fWgpp, ET_par.nu) * + fCO2mean + + ET_par.chi * (1-fAPAR) * fWsub * ppfd; + + if (etmodel == 2) + et = D * (1 + ET_par.beta/pow(D, ET_par.kappa)) * A / CO2 * + pow(fWgpp, ET_par.nu) * + fCO2mean + + ET_par.chi * (1-fAPAR) * fWsub * ppfd; + + } + + \item{returncols}{What columns are returned, defaults to + c('GPP','ET','SW'). Other possible options are fD for vapour + pressure deficit modifier, fW for soil water modifier, fE (minimum + of fD, fW), fS (temperature/season modifier), SOG (snow on ground, + mm weq.), Throughfall, Interception, Snowmelt (mm per day), + Drainage, i.e. water melted or precipitated that is above field capacity runs off with a small delay (see parameter tau), Canopywater for surfacial water storage (upper limit set by parameter Cmax and fAPAR), S season status (C) for fS calculation. } +} + + +\seealso{ + Package information: \code{\link{Rpreles}} +} + +\examples{ +## Run model with artificial inputs +CO2 <- 280:(2*380) +T=rep(18, length(CO2)) +fAPAR=rep(1, length(CO2)) +Precip=rep(3, length(CO2)) +PAR=rep(20, length(CO2)) + +## Plot CO2 effect on GPP, ET, and SW. Feedbacks through soil +## eliminated with high precipitation +pdf('testCO2.pdf', hei=10, wid=10) +op <- par(mfrow=c(4,4), mar=c(1,1,1,1), oma=c(4,4,4,4)) +for (D in c(0, 0.5, 1, 1.5)) { + D <- rep(D, length(CO2)) + o1 <- PRELES(PAR, T, D, Precip, CO2, fAPAR, + returncols=c("GPP", "ET", "SW", "fW", "fE"), LOGFLAG=0) + plot(CO2, o1$GPP) +abline(v=380) + plot(CO2, o1$ET) +abline(v=380) + plot(CO2, o1$GPP/o1$ET) +abline(v=380) + plot(CO2, o1$SW) +abline(v=380) +} +} diff --git a/man/Rpreles-package.Rd b/man/Rpreles-package.Rd new file mode 100644 index 0000000..6335969 --- /dev/null +++ b/man/Rpreles-package.Rd @@ -0,0 +1,89 @@ +\name{Rpreles-package} +\alias{Rpreles-package} +\alias{Rpreles} +\docType{package} +\title{A model set for predicting ecosystem GPP and water balance. + Model set for Climforisk Life+ project LIFE09 ENV FI 000571. +} +\description{Implements PRELES carbon-water cycle model that is really simple. It + calculates GPP following Mäkelä et al. 2008, GCB, with small + modifications to VPD-response modifier, with the inclusion of soil water + modifier. GPP prediction is used in an empirical water use-efficient + based transpiration equation that is appended by Priestley-Taylor type + of evaporation equation, which can be constrained by low soil + water. Photosynthetic radiation absorbed by the canopy influences + transpiration-evaporation fraction, each driven by photosynthetic + radiation, instead of Rnet for the sake of simplicity of input data. + Soil water balance is updated at the end of the day. Snow melts + when it is warmer than zero degrees C, and rain is assumed water when + air temperature is lower than that. There is a small surfacial canopy + water storage that is simple associated with fAPAR, and if there is + water soil water restrictions to evaporation do not apply. + + Model has been developed and calibrated in Peltoniemi et al. 2015 + for Hyytiälä and Sodankylä eddy covariance sites (Scots pine). + + Preliminary calibrations of the model show promising performance in + other Finnish and Swedish eddy covariance sites, including Norway spruce + too, implying it could be used elsewhere in boreal region as well. Use + elsewhere with caution, as it anyway is an empirical model by its + nature. + + There are options for simple extensions of model applicability: + - LUE (and gamma) parameters are associated with photosynthetic + capacisity, meaning LUE tends to be higher in deciduous. Note that it is + correlated with gamma that (Peltoniemi et al 2012, Tree Phys.). + - Seasonality controls deciduos species differently. Birch budburst is + modelled according to Linkosalo et al. (2000?). + - Spruce seems to have more sensitive fVPD-modifier than Scots pine, + which means one might try to increase kappaGPP parameter. +} +\details{ + \tabular{ll}{ + Package: \tab Rpreles\cr + Type: \tab Package\cr + Version: \tab 1.0\cr + Date: \tab 2014-2-13\cr + License: \tab \cr + } + An R interface to PRELES (and possibly later to Yasso, and NPP An overview of how to use the package, including the most important functions. +} +\author{ + Mikko Peltoniemi + + Maintainer: Mikko Peltoniemi +} +\references{ + Peltoniemi et al., Peltoniemi M., Pulkkinen M., Aurela M., Pumpanen J., Kolari P. & Mäkelä A. 2015: A semi-empirical model of boreal-forest gross primary production, evapotranspiration, and soil water — calibration and sensitivity analysis. Boreal Env. Res. 20: 151–171. +} + +\keyword{ package } +\seealso{ + Optional links to other man pages, e.g. + \code{\link[:-package]{}} +} +\examples{ +##yasso examples by Sanna Härkönen +#init <- matrix(0,length(STAND0$id),5) +#z <- matrix(0,length(STAND0$id),5) +#nw.y07<-rep(0.0,length(STAND0$id)); fw.y07<-rep(0.0,length(STAND0$id)); w.y07<-rep(0.0,length(STAND0$id)) +#t <- 10000 #time in years + +#In steady state simulations: weather data mean values 1960-2008 +#amp1_0 <- (STAND0$maxAVE-STAND0$minAVE)/2 # +#cl <- cbind(STAND0$meanAVE,STAND0$rainAVE, amp1_0) #(T_mean[C],P_annual[mm], T_amplitude[C]) + +# non-woody litter +#inf1 <- cbind(non.woody0, 0)#Input per compartments (A, W, E, N, H) +#inf2 <- cbind(fine.woody0, 0)#Input per compartments (A, W, E, N, H) +#inf3 <- cbind(woody0, 0)#Input per compartments (A, W, E, N, H) + +#input for Yasso +#inputnw=cbind(t,cl,init,inf1,s1,z,YassoParam) #input for Yasso (non-woody), YassoParam=1 denotes Scandinavian parameter set +#inputfw=cbind(t,cl,init,inf2,s2,z,YassoParam) #input for Yasso (fine-woody) +#inputw=cbind(t,cl,init,inf3,s3,z,YassoParam) #input for Yasso (woody) + +#nw.y07 <- t(apply(inputnw,1,yasso07)) +#fw.y07 <- t(apply(inputfw,1,yasso07)) +#w.y07 <- t(apply(inputw,1,yasso07)) +} diff --git a/man/plot.prebas.Rd b/man/plot.prebas.Rd new file mode 100644 index 0000000..32b730b --- /dev/null +++ b/man/plot.prebas.Rd @@ -0,0 +1,195 @@ +\name{plot.prebas} +\alias{plot.prebas} + +\title{ +Plot PREBAS outputs +} +\description{ +This function plots the outputs of PREBAS model +} +\usage{ +plot.prebas(x, variableIDs=NA, siteIDs=NA, layerIDs=NA, leg=T, layerNam = NA, obsData=NA) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{x}{ +a prebas or multiSitePrebas object. +} + \item{variableIDs}{ + a numeric vector indicating the output variables IDs to plot. See list below. +} + \item{siteIDs}{ +a numeric vector indicating the site IDs (only for a multiSitePrebas object). +} + \item{layerIDs}{ +a numeric vector indicating the layer IDs to plot. +} + \item{leg}{ +logical. If TRUE the legend is included in the plots. +} + \item{layerNam}{ +a character vector with the layer names. +} + \item{obsData}{ +a matrix with observed data. Rows are observations; Columns are 7: site IDs, layer IDs, the year of observation from the start of the simulations, variable IDs, the actual value observed, sd of the observation (if available). +} +} +\details{ +List of output variables: + + 1."siteID" \cr + 2."climID" \cr + 3."sitetype" \cr + 4."species" \cr + 5."ETS" effective temperature sums \cr + 6."P0" Potential annual gross primary production (gC m-2 y-1) \cr + 7."age" Age of the layer (years) \cr + 8."Respi_m /10000." (kgC m-2 y-1) \cr + 9."Respi_tot" Autotrophic respiration (gC m-2 y-1) \cr + 10."GPP/1000" Total GPP (kgC ha-1 y-1) \cr + 11."H" Layer average height (m) \cr + 12."D" Layer average diameter at breast height (cm) \cr + 13."BA" Layer basal area (m-2 ha-1) \cr + 14."Hc_base" Base of crown height (m) \cr + 15."Cw" Crorn width (m) \cr + 16."Lc" Length of the crown (m) \cr + 17."N" Layer density \cr + 18."npp" net primary production (gC m-2 y-1) \cr + 19."leff" Effective leaf area \cr + 20."keff" Effective light extintion coefficient \cr + 21."lproj" Projected leaf area \cr + 22."ET_preles" Annual evapotranspiration (mm m-2) \cr + 23."weight" Layer weight on photosynthesis \cr + 24."Wbranch" Branch biomass (kgC ha-1) \cr + 25."WfineRoots" Fine roots biomass (kgC ha-1) \cr + 26."Litter_fol" Foliage litter (kgC ha-1) \cr + 27."Litter_fr" Fine root litter (kgC ha-1) \cr + 28."Litter_branch" Branch litter (kgC ha-1) \cr + 29."Litter_wood" Woody litter (kgC ha-1) \cr + 30."V" Layer volume (m3 ha-1) \cr + 31."Wstem" Stem Biomass (kgC ha-1) \cr + 32."W_croot" Course root Biomass (kgC ha-1) \cr + 33."wf_STKG" Foliage biomass (kgC ha-1) \cr + 34."wf_treeKG" Foliage biomass of the average tree (kgC ha-1) \cr + 35."B_tree" Basal area of average tree (m2 ha-1) \cr + 36."Light" light interseption \cr + 37."Vharvested" harvested volume (m3 ha-1) \cr + 38."Vtot" total volume of the Layer considering also dead trees and harvested volume (m3 ha-1) \cr + 39."soilC" totaal soil carbon (kgC ha-1) \cr + 40."aSW" average available soil water (mm m-2) \cr + 41."summerSW" summer soil water (mm m-2) \cr + 42."Vmort" volume of dead trees (m3 ha-1) \cr + 43."gross growth" (m3 ha-1 y-1) \cr + 44."GPPspecies" Gross primary production per layer (gC m-2 y-1) \cr + 45."Rh species" (gC m-2 y-1) \cr + 46."NEP sp" Net ecosystem exchange (gC m-2 y-1) +%% ~~ If necessary, more details than the description above ~~ +} +\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (x, variables = NA, sites = NA, speciesIDs = NA, leg = T, + speciesNam = NA, data = NA) +{ + varNam <- getVarNam() + if (any(variables == "all") | anyNA(variables)) + variables <- c(5, 6, 8:18, 22, 24:34, 37:46) + if (inherits(x, "prebas")) { + if (anyNA(speciesIDs)) + speciesIDs <- 1:dim(x$output)[3] + nSp <- length(speciesIDs) + if (anyNA(speciesNam)) + speciesNam <- as.character(paste("sp", 1:nSp)) + count <- 0 + if (length(variables) > 1) + par(mfrow = c(2, 3)) + else par(mfrow = c(1, 1)) + for (var in variables) { + count <- count + 1 + plot(x$output[, var, speciesIDs[1], 1], type = "l", + xaxt = "n", main = varNam[var], ylab = "units", + xlab = "age (y)", col = speciesIDs[1], ylim = c(min(x$output[, + var, , 1]), max(x$output[, var, , 1]))) + if (nSp > 1) + for (ij in speciesIDs[2:nSp]) lines(x$output[, + var, ij, 1], col = ij) + axis(1, at = seq(1, (dim(x$output)[1]), length.out = 6), + labels = x$output[seq(1, (dim(x$output)[1]), + length.out = 6), 7, 1, 1]) + if (leg == TRUE) + legend("topleft", c(speciesNam[speciesIDs]), + lty = 1, col = 1:nSp) + if (count\%\%6 == 0 & var != tail(variables, n = 1)) + pause() + } + } + if (inherits(x, "multiPrebas")) { + if (anyNA(speciesIDs)) + speciesIDs <- 1:dim(x$multiOut)[4] + nSp <- length(speciesIDs) + if (anyNA(speciesNam)) + speciesNam <- as.character(paste("sp", 1:nSp)) + if (anyNA(sites)) + sites <- 1:dim(x$multiOut)[1] + for (iz in sites) { + count <- 0 + if (length(variables) > 1) + par(mfrow = c(2, 3)) + else par(mfrow = c(1, 1)) + for (var in variables) { + plot(x$multiOut[iz, , var, speciesIDs[1], 1], + type = "l", xaxt = "n", main = varNam[var], + ylab = "units", xlab = "age (y)", col = speciesIDs[1], + ylim = c(min(x$multiOut[iz, , var, , 1]), max(x$multiOut[iz, + , var, , 1]))) + if (nSp > 1) + for (ij in speciesIDs[2:nSp]) lines(x$multiOut[iz, + , var, ij, 1], col = ij) + axis(1, at = seq(1, (dim(x$multiOut)[2]), length.out = 6), + labels = x$multiOut[iz, seq(1, (dim(x$multiOut)[2]), + length.out = 6), 7, 1, 1]) + if (leg == TRUE) + legend("topleft", c(speciesNam[speciesIDs]), + lty = 1, col = speciesIDs) + if (count\%\%6 == 0) + title(paste("Site:", x$multiOut[iz, 1, 1, 1, + 1]), line = -22, outer = TRUE, cex.main = 2) + count <- count + 1 + if (count\%\%6 == 0 & var != tail(variables, n = 1)) + pause() + } + if (length(sites) > 1 & iz != tail(sites, n = 1)) + pause() + } + } + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/man/prebas.Rd b/man/prebas.Rd new file mode 100644 index 0000000..f7aafb7 --- /dev/null +++ b/man/prebas.Rd @@ -0,0 +1,292 @@ +\name{prebas} +\alias{prebas} +%- Also NEED an '\alias' for EACH other topic documented here. +\title{PREBAS forest model +%% ~~function to do ... ~~ +} +\description{ +This function runs PREBAS model. +} +\usage{ +prebas(nYears, pCROBAS = pCROB, pPRELES = pPREL, etmodel = 0, pYASSO = pYAS, pAWEN = parsAWEN, siteInfo = NA, initVar = NA, + thinning=NA,initClearcut = c(1.5,0.5,0.0431969,0.,0.),PAR,TAir,VPD,Precip,CO2, P0=NA, soilC = NA, + weatherYasso = NA, litterSize = NA, soilCtot = numeric(nYears), defaultThin = 1., + ClCut = 1., inDclct = NA, inAclct = NA, yassoRun = 0) +} +%- maybe also 'usage' for other objects documented here. +\arguments{ + \item{nYears}{ + Number of years to run the model +%% ~~Describe \code{nYears} here~~ +} + \item{pCROBAS}{ + Matrix of parameter sets, each column corresponds to a species. Default values pCROBAS = pCROB are the parameter sets for Scots pine, Norway spruce and Silver birch. print(pCROB) to see the parameter values and names. +%% ~~Describe \code{pCROBAS} here~~ +} + \item{pPRELES}{ + Parameter vector for PRELES model. Default values (pPRELES = pPREL) is the calibration for European Boreal forests (Minunno et al. 2016) +%% ~~Describe \code{pPRELES} here~~ +} + \item{etmodel}{ + Evapotranspiration model for PRELES. Default etmodel = 0. Possible values -1, 0, 1, 2 +%% ~~Describe \code{pPRELES} here~~ +} + \item{pYASSO}{ + Parameter vector for YASSO model. Default pYASSO = pYAS (Liski et al., 2017) +%% ~~Describe \code{pYASSO} here~~ +} + \item{pAWEN}{ + Matrix of parameter sets for partitioning tree organs (foliage, branch and woody) in AWEN pools. Columns referes to different species. Note that the columns of pAWEN must correspond to the species of pPRELES. Default pAWEN = parsAWEN are for Scots pine, Norway spruce and Silver birch. +%% ~~Describe \code{pYASSO} here~~ +} + \item{siteInfo}{ + Vector of site info SiteID, climID, siteType. Default = c(1,1,3), i.e. siteType = 3. +%% ~~Describe \code{siteInfo} here~~ +} + \item{initVar}{ + Matrix with initial stand values for all the tree strata. Columns correspond to the layers in the stand. Initial information needed are: SpeciesID (a number corresponding to the species parameter values of pPRELES columns), Age (years), average height of the layer (H, m), average diameter at breast height of the layer (D, cm), basal area of the layer (BA, m2 ha-1), average height of the crown base of the layer (Hc, m). If initVar is not provided the model is initialized from plantation using default planting parameters (see initClearcut) and assuming that Pine, Spruce and Birch are equally present at plantation. +%% ~~Describe \code{initVar} here~~ +} + \item{thinning}{ + A matrix with thinnig inputs. Rows correspond to a thinning event. Column 1 year from the start of the simulation; column 2 is siteID; column 3 layer where thinnings are carried out; column 4 to 7 stand variables (H, D, B, Hc); column 8 parameter that indicates if the stand variables (column 4:7) are provided as fraction of the actual model outputs. (see examples) +%% ~~Describe \code{thinning} here~~ +} + \item{initClearcut}{ + A numeric vector with initial stand variables after clearcut: H, D, BA, Hc, Ainit. Ainit is the year when the stand reaches the default values = c(1.5,0.5,0.0431969,0.,0.) and is automatically computed using air temperature. +%% ~~Describe \code{initClearcut} here~~ +} + \item{PAR}{ + A numeric vector of daily sums of photosynthetically active radiation, mmol/m2. +%% ~~Describe \code{PAR} here~~ +} + \item{TAir}{ + A numeric vector of daily mean temperature, degrees C. +%% ~~Describe \code{TAir} here~~ +} + \item{VPD}{ + A numeric vector of daily mean vapour pressure deficits, kPa. +%% ~~Describe \code{VPD} here~~ +} + \item{Precip}{ + A numeric vector of daily rainfall, mm +%% ~~Describe \code{Precip} here~~ +} + \item{CO2}{ + A numeric vector of air CO2, ppm +%% ~~Describe \code{CO2} here~~ +} + \item{P0}{ + A numeric vector with the annual potential photosynthesis (gC m-2 y-1). If P0 is not provided PRELES is used to compute P0 using fAPAR = 1. +%% ~~Describe \code{P0} here~~ +} + \item{soilC}{ + Initial soil carbon compartments for each layer. Array with dimentions = c(nYears,5,3,nLayers). The second dimention (5) corresponds to the AWENH pools; the third dimention (3) corresponds to the tree organs (foliage, branch and stem). +%% ~~Describe \code{soilC} here~~ +} + \item{weatherYasso}{ + Annual weather inputs for Yasso. +%% ~~Describe \code{weatherYasso} here~~ +} + \item{litterSize}{ + Marix with litter inputs for YASSO. Rows are tree organs, columns correspond to the layers. +%% ~~Describe \code{litterSize} here~~ +} + \item{soilCtot}{ + Vector with total initial soil carbon +%% ~~Describe \code{soilCtot} here~~ +} + \item{defaultThin}{ + If defaultThin = 1 (default) Finnish standard managment practices are applied (ref). +%% ~~Describe \code{defaultThin} here~~ +} + \item{ClCut}{ + If ClCut = 1 clearcuts are applied. If inDclct = NA and inAclct = NA Finnish standard clearcut practices are applied (ref). +%% ~~Describe \code{ClCut} here~~ +} + \item{inDclct}{ + Vector of Diameter (cm) threshold for clearcut. Each element correspond to a layer of the stand, if only one value is provided the same value is applied to all the layers. The different elements of the vector are for the different layers. The dominant species (highest basal area) is considered for clearcut. +%% ~~Describe \code{inDclct} here~~ +} + \item{inAclct}{ + Vector of Age (year) threshold for clearcut. Each element correspond to a layer of the stand, if only one value is provided the same value is applied to all the layers. The different elements of the vector are for the different layers. The dominant species (highest basal area) is considered for clearcut. +%% ~~Describe \code{inAclct} here~~ +} + \item{yassoRun}{ + If yassoRun=1 the YASSO model is run to compute the carbon balance of the soil. +%% ~~Describe \code{yassoRun} here~~ +} +} +\details{ +%% ~~ If necessary, more details than the description above ~~ +} +\value{ + \item{output}{ + An array with annual model outputs. 1st dimension corresponds to the number of years of the simulation (nYears); 2nd dimension corresponds to the output variables (see list below); 3rd dimension corresponds to the number of layers in the stand (nLayers); 4th dimensions reports the state of the stand (1) and (2) the variables of the harvested trees (2). + + Output variables: + 1."siteID" \cr + 2."climID" \cr + 3."sitetype" \cr + 4."species" \cr + 5."ETS" effective temperature sums \cr + 6."P0" Potential annual gross primary production (gC m-2 y-1) \cr + 7."age" Age of the layer (years) \cr + 8."Respi_m /10000." (kgC m-2 y-1) \cr + 9."Respi_tot" Autotrophic respiration (gC m-2 y-1) \cr + 10."GPP/1000" Total GPP (kgC ha-1 y-1) \cr + 11."H" Layer average height (m) \cr + 12."D" Layer average diameter at breast height (cm) \cr + 13."BA" Layer basal area (m-2 ha-1) \cr + 14."Hc_base" Base of crown height (m) \cr + 15."Cw" Crorn width (m) \cr + 16."Lc" Length of the crown (m) \cr + 17."N" Layer density \cr + 18."npp" net primary production (gC m-2 y-1) \cr + 19."leff" Effective leaf area \cr + 20."keff" Effective light extintion coefficient \cr + 21."lproj" Projected leaf area \cr + 22."ET_preles" Annual evapotranspiration (mm m-2) \cr + 23."weight" Layer weight on photosynthesis \cr + 24."Wbranch" Branch biomass (kgC ha-1) \cr + 25."WfineRoots" Fine roots biomass (kgC ha-1) \cr + 26."Litter_fol" Foliage litter (kgC ha-1) \cr + 27."Litter_fr" Fine root litter (kgC ha-1) \cr + 28."Litter_branch" Branch litter (kgC ha-1) \cr + 29."Litter_wood" Woody litter (kgC ha-1) \cr + 30."V" Layer volume (m3 ha-1) \cr + 31."Wstem" Stem Biomass (kgC ha-1) \cr + 32."W_croot" Course root Biomass (kgC ha-1) \cr + 33."wf_STKG" Foliage biomass (kgC ha-1) \cr + 34."wf_treeKG" Foliage biomass of the average tree (kgC ha-1) \cr + 35."B_tree" Basal area of average tree (m2 ha-1) \cr + 36."Light" light interseption \cr + 37."Vharvested" harvested volume (m3 ha-1) \cr + 38."Vtot" total volume of the Layer considering also dead trees and harvested volume (m3 ha-1) \cr + 39."soilC" totaal soil carbon (kgC ha-1) \cr + 40."aSW" average available soil water (mm m-2) \cr + 41."summerSW" summer soil water (mm m-2) \cr + 42."Vmort" volume of dead trees (m3 ha-1) \cr + 43."gross growth" (m3 ha-1 y-1) \cr + 44."GPPspecies" Gross primary production per layer (gC m-2 y-1) \cr + 45."Rh species" (gC m-2 y-1) \cr + 46."NEP sp" Net ecosystem exchange (gC m-2 y-1)} + \item{dailyPRELES}{ + Matrix with daily output from preles. 1st column is the daily GPP (gC m-2 d-1), 2nd column daily evapotranspiration (mm m-2), 3rd column daily soil water (mm -2). + }%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +} +\references{ +%% ~put references to the literature/web site here ~ +} +\author{ +Francesco Minunno +%% ~~who you are~~ +} +\note{ +%% ~~further notes~~ +} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +\seealso{ +%% ~~objects to See Also as \code{\link{help}}, ~~~ +} +\examples{ +##---- Should be DIRECTLY executable !! ---- +##-- ==> Define data, use random, +##-- or do help(data=index) for the standard data sets. + +## The function is currently defined as +function (nYears, pCROBAS = pCROB, pPRELES = pPREL, pYASSO = pYAS, + siteInfo = NA, thinning = matrix(0, 2, 10), nThinning = max(2, + nrow(thinning)), initClearcut = c(1.5, 0.5, 0.0431969, + 0, 0), PAR, TAir, VPD, Precip, CO2, P0 = NA, initVar = NA, + soilC = array(0, dim = c(nYears, 5, 3, 3)), weatherYasso = matrix(0, + nYears, 3), litterSize = matrix(0, 3, 3), soilCtot = numeric(nYears), + defaultThin = 1, ClCut = 1, inDclct = NA, inAclct = NA, yassoRun = 0) +{ + nLayers <- ifelse(!is.na(initVar), ncol(initVar), 3) + nSp = ncol(pCROBAS) + if (is.na(siteInfo)) + siteInfo = c(1, 1, 3) + varNam <- getVarNam() + nVar <- length(varNam) + nLayers <- nSp <- ncol(pCROBAS) + layerNam <- paste("layer", 1:nSp) + output <- array(0, dim = c((nYears), nVar, nSp, 2), dimnames = list(NULL, + varNam, layerNam, c("stand", "thinned"))) + fAPAR <- rep(0.7, nYears) + Temp <- TAir[1:(365 * nYears)] - 5 + ETS <- pmax(0, Temp, na.rm = T) + ETS <- matrix(ETS, 365, nYears) + ETS <- colSums(ETS) + if (is.na(P0)) { + P0 <- PRELES(DOY = rep(1:365, nYears), PAR = PAR, TAir = TAir, + VPD = VPD, Precip = Precip, CO2 = CO2, fAPAR = rep(1, + length(PAR)), LOGFLAG = 0, p = pPRELES)$GPP + P0 <- matrix(P0, 365, nYears) + P0 <- colSums(P0) + } + ETSthres <- 1000 + ETSmean <- mean(ETS) + if (any(!is.na(c(inDclct, inAclct)))) { + if (is.na(inDclct)) + inDclct <- 9999999.99 + if (is.na(inAclct)) + inAclct <- 9999999.99 + } + if (ClCut == 1 & is.na(initVar) & is.na(inDclct)) + inDclct <- c(ClCutD_Pine(ETSmean, ETSthres, siteInfo[3]), + ClCutD_Spruce(ETSmean, ETSthres, siteInfo[3]), ClCutD_Birch(ETSmean, + ETSthres, siteInfo[3])) + if (ClCut == 1 & is.na(initVar) & is.na(inAclct)) + inAclct <- c(ClCutA_Pine(ETSmean, ETSthres, siteInfo[3]), + ClCutA_Spruce(ETSmean, ETSthres, siteInfo[3]), ClCutA_Birch(ETSmean, + ETSthres, siteInfo[3])) + if (any(is.na(inDclct))) + inDclct[is.na(inDclct)] <- 9999999.99 + if (length(inDclct) == 1) + inDclct <- rep(inDclct, nSp) + if (any(is.na(inAclct))) + inAclct[is.na(inAclct)] <- 9999999.99 + if (length(inAclct) == 1) + inAclct <- rep(inAclct, nSp) + if (is.na(initVar)) { + initVar <- matrix(NA, 6, nSp) + initVar[1, ] <- 1:nSp + initVar[3, ] <- initClearcut[1] + initVar[4, ] <- initClearcut[2] + initVar[5, ] <- initClearcut[3]/nSp + initVar[6, ] <- initClearcut[4] + } + xx <- min(10, nYears) + Ainit = 6 + 2 * 3.5 - 0.005 * (sum(ETS[1:xx])/xx) + 2.25 + initVar[2, which(is.na(initVar[2, ]))] <- initClearcut[5] <- round(Ainit) + weatherPreles <- array(c(PAR, TAir, VPD, Precip, CO2), dim = c(365, + nYears, 5)) + weatherPreles <- aperm(weatherPreles, c(2, 1, 3)) + prebas <- .Fortran("prebas", nYears = as.integer(nYears), + nLayers = as.integer(nLayers), nSp = as.integer(nSp), + siteInfo = as.numeric(siteInfo), pCROBAS = as.matrix(pCROBAS), + initVar = as.matrix(initVar), thinning = as.matrix(thinning), + output = as.array(output), nThinning = as.integer(nThinning), + maxYearSite = as.integer(nYears), fAPAR = as.numeric(fAPAR), + initClearcut = as.numeric(initClearcut), ETS = as.numeric(ETS), + P0 = as.numeric(P0), weather = as.array(weatherPreles), + DOY = as.integer(1:365), pPRELES = as.numeric(pPRELES), + soilC = as.array(soilC), pYASSO = as.numeric(pYASSO), + weatherYasso = as.matrix(weatherYasso), litterSize = as.matrix(litterSize), + soilCtot = as.numeric(soilCtot), defaultThin = as.double(defaultThin), + ClCut = as.double(ClCut), inDclct = as.double(inDclct), + inAclct = as.double(inAclct), yassoRun = as.double(yassoRun)) + class(prebas) <- "prebas" + return(prebas) + } +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") +\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line diff --git a/src/A_routines.f90 b/src/A_routines.f90 new file mode 100644 index 0000000..dd79c54 --- /dev/null +++ b/src/A_routines.f90 @@ -0,0 +1,782 @@ +SUBROUTINE Ffotos2(STAND_all,nClass,nSp,pCrobas,nVar,nPar,MeanLight,coeff,qcTOT) +implicit none + + integer, intent(in) :: nclass,nSp,nVar,nPar + +!***************************************************************************************** + real (kind=8), intent(in) :: pCrobas(npar,nSp) + real (kind=8), intent(inout) :: STAND_all(nVar,nclass) + real (kind=8), intent(inout) :: coeff(nclass) , qcTOT +!**************************************************************************************** + integer :: ki + real (kind=8) :: param(nPar) + real (kind=8) :: ht(nclass),hc(nclass),h(nclass) + real (kind=8) :: LAIe(nclass),qc(nclass),btc(nclass),LAI(nclass),N(nclass) + real (kind=8) :: l(2*nclass),vrel(2*nclass,nclass) + real (kind=8) :: lpt(2*nclass,nclass),lt(2*nclass) + real (kind=8) :: bt(2*nclass), k(nclass), par_betab(nclass), rc(nclass) + real (kind=8) :: kLAIetot, kLAItot, Atot + real (kind=8), intent(inout) :: MeanLight(nclass) + real (kind=8) :: x1,x2,apuJ,apuI + integer :: iclass,i2,i1,species,nv !!**!! nv defined as integer + integer :: i, j, ii(2*nclass), iapu + real (kind=8) :: apu, b1, qctot0, qctot1, wwx, dc, e1 +!**************************************************************************************** + real (kind=8) :: pi = acos(-1.) + + MeanLight = 0. + coeff = 0. + qcTOT = 0. + + do i = 1,nclass + species = int(stand_all(4,i)) + param = pCrobas(:,species) + qc(i) = 0. + + ht(i) = STAND_all(11,i) ! H + hc(i) = STAND_all(14,i) ! Hc + h(i) = ht(i) - hc(i) ! Lc + LAIe(i) = STAND_all(19,i) ! leff + k(i) = PARAM(4) ! k + LAI(i) = STAND_all(33,i) * PARAM(3) / 10000. ! WF_stand * sla + par_betab(i) = PARAM(17) ! betab + rc(i) = STAND_all(15,i)/2. ! rc + N(i) = STAND_all(17,i) / 10000. ! N per m2 + end do + + nv= 2*nclass + +do i = 1, nv + ii(i) = i +end do + + +! ** sort tree tops and crown bases in descending order into vector l + +do i=1,nclass + l(i) = ht(i) + l(i+nclass) = hc(i) +end do + + +do i=1,nv-1 + do j=i+1,nv + if(l(i).lt.l(j)) then + apu = l(i) + l(i) = l(j) + l(j) = apu + +! ii-table sorts the l-table indeces so that later the corresponding "locations" for hc and ht values can be located + iapu = ii(i) + ii(i) = ii(j) + ii(j) = iapu + endif + end do +end do + +! ** end sort +! ** calculate effective leaf area for each species in canopy layers determined by heights and hc:s +! ** use function wwx to calculate foliage distribution, defined by species + +lt(1) = 0. +bt(1) = 0. +do i=1,nv-1 + + lt(i+1) = 0. + do j=1,nclass + species = j + apuJ = wwx(0.0d+0,1.0d+0,ht(j)-hc(j),species) + if(l(i).gt.hc(j).and.l(i+1).lt.ht(j)) then + if((ht(j)-hc(j)).gt.0.) then + x1 = (ht(j)-l(i))/(ht(j)-hc(j)) + x2 = (ht(j)-l(i+1))/(ht(j)-hc(j)) + else + x1=0. + x2=0. + endif + apuI = wwx(x1,x2,ht(j)-hc(j),species) + vrel(i+1,j) = apuI / apuJ + else + vrel(i+1,j) = 0. + endif + lpt(i+1,j) = k(j) * LAIe(j) * vrel(i+1,j) + lt(i+1) = lt(i+1) + lpt(i+1,j) + end do + bt(i+1) = bt(i) + lt(i+1) +end do + + +do j=1,nclass + dc = 0. + i1 = 0 + i2 = 0 + do i=1,nv + if(ht(j).eq.l(i)) i1=i + if(hc(j).eq.l(i)) i2=i + + if(ii(i)==j) i1 = i + if(ii(i) == j+nclass) i2 = i + +! if(ht(j).gt.l(i).and.hc(j).le.l(i)) dc=dc+lt(i) + end do + e1 = exp(-bt(i1)) - exp(-bt(i2)) + b1 = bt(i2) - bt(i1) + + if (b1 .ne. 0) qc(j) = k(j) * laie(j) * e1 / b1 + + btc(j) = bt(i2) + +! MeanLight(j) = 0.5 * (exp(-bt(i1)) + exp(-bt(i2))) + MeanLight(j) = exp(-bt(i2)) +end do + + + + +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! +! ** add a new more simple way of dividing between size classes +! +! Here the fAPAR for the whole stand is calculated +! (stored in qc(in), same for all classes), and trees +! utilise this in proportion to their foliage mass +! +! AM 2.7.2008 +! +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! +kLAIetot = 0. +kLAItot = 0. +Atot = 0. +qcTOT1 = 0 +do i =1,nclass + kLAIetot = kLAIetot + k(i) * LAIe(i) + kLAItot = kLAItot + k(i) * LAI(i) + Atot = Atot + N(i) * pi*(rc(i)**2 ) + qcTOT1 = qcTOT1 + qc(i) +end do + +! calculate LPJ style fAPAR and use the smaller of the two + + if(Atot > 0. ) then + qcTOT0 = (1. - exp(-kLAItot/ Atot)) * Atot + else + qctot = 0. + endif + + qcTOT = min(qcTOT0,qctot1) +! qctot = qctot1 + +! if(stand_P(7) > 150) then +! continue +! endif + + +! calculate weights - on the basis of qcTOT1 but all downscaled if qcTOT0 < qcTOT1 +! +!do i = 1,nclass + + if(qcTOT1.gt.0.) then + coeff = qc / qcTOT1 * qcTOT / qcTOT1 ! weight + +! coeff_SP = qc(2) / qcTOT1 * qcTOT / qcTOT1 ! + +! coeff_B = qc(3) / qcTOT1 * qcTOT / qcTOT1 ! + + + +!!!!FMadded +! qcTOT = qcTOT * (coeff_P+coeff_SP+coeff_B) + +! coeff_P = coeff_P/(coeff_P+coeff_SP+coeff_B) +! coeff_SP = coeff_SP/(coeff_P+coeff_SP+coeff_B) +! coeff_B = coeff_B/(coeff_P+coeff_SP+coeff_B) +!!!! + + +! if(kLAIetot.gt.0.) then +! coeff_P = k(1)*LAIe(1) / kLAIetot ! weight + +! coeff_SP = k(2)*LAIe(2) / kLAIetot ! + +! coeff_B = k(3)*LAIe(3) / kLAIetot ! + + +! else +! coeff_P = 1./3. +! coeff_SP = 1./3. +! coeff_B = 1./3. + +! end do + endif + + + + ! write(60,*)qcTOT, qcTOT1, qc(1), qc(2), qc(3) + +!81 continue + + + end subroutine Ffotos2 + + +!*************************************************************** +! WWX +! +! Alkuper?inen Annikki M?kel? +! +! MUUTOKSIA (Sanna H?rk?nen, 14.8.2002): +! -Lis?tty muuttujien m??rittelyt +! +! MUUTOKSIA (Annikki M?kel? 19.11.2004): +! -Muutettu funktiokutsun argumentteja (hc, species) +! -M?nnyn malli ennallaan kuuselle uusi formulointi +! -Kuusella latvan maksimi aina annetulla kohdalla, <= 5m +! +!*************************************************************** + real(kind=8) function wwx(x1,x2,Lc,species) + + implicit none + + real (kind=8), parameter :: hmax0 = 5., p = 1., q = 1. + + real (kind=8) :: x1,x2,Lc + integer :: species + + real (kind=8) :: pp,qq + integer :: N,i + real (kind=8) :: x,dx,apu,a,b,c,d,w + + + +! if(species==1 .OR. species==3)then + pp = p + qq = q +! endif + + +!!!check with Annikki +! if(species==4)then +!! hmax = amin1(0.9*Lc,hmax0+0.3*Lc) +! pp = p +!! *** If-lause lis?tty 2011/10/14 by TL +! if (Lc .gt. hmax0) then +! qq = 0.18 * Lc - 0.6 +! else +! qq = 0.18 * hmax0 - 0.6 +! endif +! endif + + N = max(1,int((x2-x1)*10 + 0.5)) + dx = (x2-x1)/float(N) + + w = 0. + x = x1 + + do i = 1,N + if(x+dx>1.)x=1.-dx + A = x**pp * (1.-x)**qq + B = (x+dx/2.)**pp * (1.-x-dx/2.)**qq + C = B + apu = max(0.,1.-x-dx) + D = (x+dx)**pp * apu**qq + w = w + (A+2.*B+2.*c+D)/6. + x = x+dx + end do + + wwx = w*dx + end function wwx +!************************************************************* + + + +subroutine preles(weather,DOY,fAPAR,prelesOut,pars,GPP,ET,SW,etmodel)!,p0) + +implicit none + + INTERFACE + SUBROUTINE call_preles( & + PAR, TAir, VPD, Precip, CO2, fAPARc, & !inputs + GPPmeas, ETmeas, SWmeas, & + GPP, ET, SW, SOG, fS, fD, fW, fE, & !outputs + Throughfall, Interception, Snowmelt, Drainage, & + Canopywater, S, & + soildepth,ThetaFC, ThetaPWP, tauDrainage, beta, & !parameters + tau,S0,Smax,kappa,gamma, soilthres, bCO2, xCO2, & + ETbeta, ETkappa, ETchi,ETsoilthres,ETnu, MeltCoef, & + I0,CWmax,SnowThreshold,T_0,SWinit,CWinit,SOGinit, & + Sinit,t0,tcrit,tsumcrit, & + etmodel, LOGFLAG,NofDays, & + day, &!!!!this is DOY + transp, evap, fWE) BIND(C) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT, C_CHAR, C_PTR, C_DOUBLE + real ( C_DOUBLE ) :: PAR(365), TAir(365), VPD(365), Precip(365), CO2(365), fAPARc(365) + real ( c_double ) :: GPPmeas(365), ETmeas(365), SWmeas(365) + real ( c_double ) :: GPP(365), ET(365), SW(365), SOG(365), fS(365), fD(365), fW(365), fE(365) + real ( c_double ) :: Throughfall(365), Interception(365), Snowmelt(365), Drainage(365) + real ( c_double ) :: Canopywater(365), S(365) + real ( c_double ) :: soildepth,ThetaFC, ThetaPWP, tauDrainage, beta !parameters + real ( c_double ) :: tau,S0,Smax,kappa,gamma, soilthres, bCO2, xCO2 + real ( c_double ) :: ETbeta, ETkappa, ETchi,ETsoilthres,ETnu, MeltCoef + real ( c_double ) :: I0,CWmax,SnowThreshold,T_0,SWinit,CWinit,SOGinit + real ( c_double ) :: Sinit,t0,tcrit,tsumcrit + integer(c_int) :: etmodel, LOGFLAG,NofDays + integer(c_int) :: day(365) + real ( c_double ) :: transp(365), evap(365), fWE(365) + END SUBROUTINE call_preles + END INTERFACE + + real (kind=8), intent(in) :: weather(365,5),fAPAR(365) + real (kind=8), intent(out) :: prelesOut(16)!,p0 + real (kind=8), intent(inout) :: pars(30) + integer, intent(in):: DOY(365), etmodel + + real (kind=8) PAR(365), TAir(365), VPD(365), Precip(365), CO2(365), fAPARc(365) + real (kind=8) GPPmeas(365), ETmeas(365), SWmeas(365) + real (kind=8), intent(inout) :: GPP(365), ET(365),SW(365) + real (kind=8) SOG(365), fS(365), fD(365), fW(365), fE(365) + real (kind=8) Throughfall(365), Interception(365), Snowmelt(365), Drainage(365) + real (kind=8) Canopywater(365), S(365) + real (kind=8) :: soildepth,ThetaFC, ThetaPWP, tauDrainage, beta !parameters + real (kind=8) :: tau,S0,Smax,kappa,gamma, soilthres, bCO2, xCO2 + real (kind=8) :: ETbeta, ETkappa, ETchi,ETsoilthres,ETnu, MeltCoef + real (kind=8) :: I0,CWmax,SnowThreshold,T_0,SWinit,CWinit,SOGinit + real (kind=8) :: Sinit,t0,tcrit,tsumcrit + integer LOGFLAG,NofDays + integer day(365),nDays + real (kind=8) transp(365), evap(365), fWE(365)!,fAPAR0 + +!init inputs +PAR = weather(:,1) +TAir = weather(:,2) +VPD = weather(:,3) +Precip = weather(:,4) +CO2 = weather(:,5) + +day = DOY +NofDays = 365 +!fAPAR0 = 1 + +GPPmeas(:) = 0. +ETmeas(:) = 0. +SWmeas(:) = 0. +!etmodel=0. +LOGFLAG=0 + +!if(PAR(366)==-999) then + nDays = 365 +!else +! nDays = 366 +!endif + +!init preles parameters +soildepth = pars(1) +ThetaFC = pars(2) +ThetaPWP = pars(3) +tauDrainage = pars(4) +beta = pars(5) +tau = pars(6) +S0 = pars(7) +Smax = pars(8) +kappa = pars(9) +gamma = pars(10) +soilthres = pars(11) +bCO2 = pars(12) +xCO2 = pars(13) +ETbeta = pars(14) +ETkappa = pars(15) +ETchi = pars(16) +ETsoilthres = pars(17) +ETnu = pars(18) +MeltCoef = pars(19) +I0 = pars(20) +CWmax = pars(21) +SnowThreshold = pars(22) +T_0 = pars(23) +SWinit = pars(24) +CWinit = pars(25) +SOGinit = pars(26) +Sinit = pars(27) +t0 = pars(28) +tcrit = pars(29) +tsumcrit = pars(30) + + +fAPARc = fAPAR + call call_preles( & + PAR, TAir, VPD, Precip, CO2, fAPARc, & !inputs + GPPmeas, ETmeas, SWmeas, &!end inputs + GPP, ET, SW, SOG, fS, fD, fW, fE, & !outputs + Throughfall, Interception, Snowmelt, Drainage, & + Canopywater, S, & !end outputs + soildepth,ThetaFC, ThetaPWP, tauDrainage, beta, & !parameters + tau,S0,Smax,kappa,gamma, soilthres, bCO2, xCO2, & + ETbeta, ETkappa, ETchi,ETsoilthres,ETnu, MeltCoef, & + I0,CWmax,SnowThreshold,T_0,SWinit,CWinit,SOGinit, & + Sinit,t0,tcrit,tsumcrit, & !end parameters + etmodel, LOGFLAG, NofDays, & + day, &!!!!this is DOY + transp, evap, fWE) + + +prelesOut(1) = sum(GPP(1:nDays)) +prelesOut(2) = sum(ET(1:nDays)) +prelesOut(3) = SW(nDays) +prelesOut(4) = SOG(nDays) +prelesOut(5) = fS(nDays) +prelesOut(6) = fD(nDays) +prelesOut(7) = fW(nDays) +prelesOut(8) = fE(nDays) +prelesOut(9) = Throughfall(nDays) +prelesOut(10) = Interception(nDays) +prelesOut(11) = Snowmelt(nDays) +prelesOut(12) = Drainage(nDays) +prelesOut(13) = Canopywater(nDays) +prelesOut(14) = S(nDays) +prelesOut(15) = sum(SW(1:nDays))/nDays +prelesOut(16) = sum(SW(152:243))/92 + +end subroutine + + +SUBROUTINE mod5c(theta,time,climate,init,b,d,leac,xt,steadystate_pred) +IMPLICIT NONE + !********************************************* & + ! GENERAL DESCRIPTION FOR ALL THE MEASUREMENTS + !********************************************* & + ! returns the model prediction xt for the given parameters + ! 1-16 matrix A entries: 4*alpha, 12*p + + ! 17-21 Leaching parameters: w1,...,w5 IGNORED IN THIS FUNCTION + + ! 22-23 Temperature-dependence parameters for AWE fractions: beta_1, beta_2 + + ! 24-25 Temperature-dependence parameters for N fraction: beta_N1, beta_N2 + + ! 26-27 Temperature-dependence parameters for H fraction: beta_H1, beta_H2 + + ! 28-30 Precipitation-dependence parameters for AWE, N and H fraction: gamma, gamma_N, gamma_H + + ! 31-32 Humus decomposition parameters: p_H, alpha_H (Note the order!) + + ! 33-35 Woody parameters: theta_1, theta_2, r + + REAL (kind=8),DIMENSION(35),INTENT(IN) :: theta ! parameters + REAL (kind=8),INTENT(IN) :: time,d,leac ! time,size,leaching + REAL (kind=8),DIMENSION(3),INTENT(IN) :: climate ! climatic conditions + REAL (kind=8),DIMENSION(5),INTENT(IN) :: init ! initial state + REAL (kind=8),DIMENSION(5),INTENT(IN) :: b ! infall + REAL (kind=8),DIMENSION(5),INTENT(OUT) :: xt ! the result i.e. x(t) + REAL (kind=8),INTENT(IN) :: steadystate_pred ! set to true if ignore 'time' and compute solution + ! LOGICAL,OPTIONAL,INTENT(IN) :: steadystate_pred ! set to true if ignore 'time' and compute solution + ! in steady-state conditions (which sould give equal solution as if time is set large enough) + REAL (kind=8),DIMENSION(5,5) :: A,At,mexpAt + INTEGER :: i + REAL (kind=8),PARAMETER :: pi = 3.141592653589793 + REAL (kind=8) :: tem,temN,temH,size_dep + REAL (kind=8),DIMENSION(5) :: te + REAL (kind=8),DIMENSION(5) :: z1,z2 + REAL (kind=8),PARAMETER :: tol = 1E-12 + LOGICAL :: ss_pred = .FALSE. + + ! IF(PRESENT(steadystate_pred)) THEN + ! ss_pred = steadystate_pred + ! ENDIF + IF(steadystate_pred == 1.) THEN + ss_pred = .true. + ENDIF + + !######################################################################### + ! Compute the coefficient matrix A for the differential equation + + ! temperature annual cycle approximation + te(1) = climate(1)+4*climate(3)*(1/SQRT(2.0)-1)/pi + te(2) = climate(1)-4*climate(3)/SQRT(2.0)/pi + te(3) = climate(1)+4*climate(3)*(1-1/SQRT(2.0))/pi + te(4) = climate(1)+4*climate(3)/SQRT(2.0)/pi + + tem = 0.0 + temN = 0.0 + temH = 0.0 + DO i = 1,4 ! Average temperature dependence + tem = tem+EXP(theta(22)*te(i)+theta(23)*te(i)**2.0)/4.0 ! Gaussian + temN = temN+EXP(theta(24)*te(i)+theta(25)*te(i)**2.0)/4.0 + temH = temH+EXP(theta(26)*te(i)+theta(27)*te(i)**2.0)/4.0 + END DO + + ! Precipitation dependence + tem = tem*(1.0-EXP(theta(28)*climate(2)/1000.0)) + temN = temN*(1.0-EXP(theta(29)*climate(2)/1000.0)) + temH = temH*(1.0-EXP(theta(30)*climate(2)/1000.0)) + + ! Size class dependence -- no effect if d == 0.0 + size_dep = MIN(1.0,(1.0+theta(33)*d+theta(34)*d**2.0)**(-ABS(theta(35)))) + + ! check rare case where no decomposition happens for some compartments + ! (basically, if no rain) + IF (tem <= tol) THEN + xt = init + b*time + return + END IF + + ! Calculating matrix A (will work ok despite the sign of alphas) + DO i = 1,3 + A(i,i) = -ABS(theta(i))*tem*size_dep + END DO + A(4,4) = -ABS(theta(4))*temN*size_dep + + A(1,2) = theta(5)*ABS(A(2,2)) + A(1,3) = theta(6)*ABS(A(3,3)) + A(1,4) = theta(7)*ABS(A(4,4)) + A(1,5) = 0.0 ! no mass flows from H -> AWEN + A(2,1) = theta(8)*ABS(A(1,1)) + A(2,3) = theta(9)*ABS(A(3,3)) + A(2,4) = theta(10)*ABS(A(4,4)) + A(2,5) = 0.0 + A(3,1) = theta(11)*ABS(A(1,1)) + A(3,2) = theta(12)*ABS(A(2,2)) + A(3,4) = theta(13)*ABS(A(4,4)) + A(3,5) = 0.0 + A(4,1) = theta(14)*ABS(A(1,1)) + A(4,2) = theta(15)*ABS(A(2,2)) + A(4,3) = theta(16)*ABS(A(3,3)) + A(4,5) = 0.0 + A(5,5) = -ABS(theta(32))*temH ! no size effect in humus + DO i = 1,4 + A(5,i) = theta(31)*ABS(A(i,i)) ! mass flows AWEN -> H (size effect is present here) + END DO + + ! Leaching (no leaching for humus) + DO i = 1,4 + A(i,i) = A(i,i)+leac*climate(2)/1000.0 + END DO + + !######################################################################### + ! Solve the differential equation x'(t) = A(theta)*x(t) + b, x(0) = init + + IF(ss_pred) THEN + ! Solve DE directly in steady state conditions (time = infinity) + ! using the formula 0 = x'(t) = A*x + b => x = -A^-1*b + CALL solve(-A, b, xt) + ELSE + ! Solve DE in given time + z1 = MATMUL(A,init) + b + At = A*time !At = A*t + CALL matrixexp(At,mexpAt) + z2 = MATMUL(mexpAt,z1) - b + CALL solve(A,z2,xt) ! now it can be assumed A is non-singular + ENDIF + + END SUBROUTINE mod5c + + !######################################################################### + ! Functions for solving the diff. equation, adapted for the Yasso case + SUBROUTINE matrixexp(A,B) + IMPLICIT NONE + ! Approximated matrix exponential using Taylor series with scaling & squaring + ! Accurate enough for the Yasso case + INTEGER,PARAMETER :: n = 5 + REAL (kind=8),DIMENSION(n,n),INTENT(IN) :: A + REAL (kind=8),DIMENSION(n,n),INTENT(OUT) :: B + REAL (kind=8),DIMENSION(n,n) :: C,D + REAL (kind=8) :: p,normiter + INTEGER :: i,q,j + q = 10 ! #terms in Taylor + B = 0.0 + DO i = 1,n + B(i,i) = 1.0 + END DO + normiter = 2.0 ! Amount of scaling & squaring + j = 1 + CALL matrixnorm(A, p) + DO + IF (p 1) THEN + pk = k-1+q + A(k:pk:pk-k,:) = A(pk:k:k-pk,:) + b(k:pk:pk-k) = b(pk:k:k-pk) + END IF + !write(*,*) 'Pivot elements are: ', A(k:n,k) + END SUBROUTINE pivot + + + + ! SUBROUTINE deadWoodV(y,nY,deadVol,dbh, pars) + ! ! calculating deadwood volume decay + ! IMPLICIT NONE + ! INTEGER,intent(in) :: nY + ! REAL (kind=8),intent(in) :: y(nY),dbh,pars(4) + ! REAL (kind=8),intent(inout) :: deadVol(nY) + ! !parameters +! ! REAL (kind=8) :: p1 = -2.653,p2 = -2.948,p3 = -3.324,p4 = .055,p5 = .059,p6 = .135,p7 = -0.03 + + ! !###Gomprtz models + ! deadVol = exp(-exp(pars(1) + pars(2)*y + pars(3)*dbh + pars(4))) + ! END SUBROUTINE deadWoodV + + + + +! Note for Birch Betula pubenscens and brown leaves is used + SUBROUTINE compAWENH(Lit,AWENH,parsAWEN) + IMPLICIT NONE + INTEGER,PARAMETER :: n = 5 + REAL (kind=8),DIMENSION(n),INTENT(OUT) :: AWENH + REAL (kind=8),INTENT(IN) :: Lit,parsAWEN(4) + AWENH(1) = parsAWEN(1)*Lit + AWENH(2) = parsAWEN(2)*Lit + AWENH(3) = parsAWEN(3)*Lit + AWENH(4) = parsAWEN(4)*Lit + ! AWENH(5) = 0. + END SUBROUTINE compAWENH + +!! Note for Birch Betula pubenscens and brown leaves is used +! SUBROUTINE foliageAWENH(Lf,folAWENH) +! IMPLICIT NONE +! INTEGER,PARAMETER :: n = 5, nSp=3 +! REAL (kind=8),DIMENSION(nSp,n),INTENT(OUT) :: folAWENH +! REAL (kind=8),DIMENSION(nSp),INTENT(IN) :: Lf +!! folAWENH = 0. +! folAWENH(1,1) = 0.518*Lf(1) +! folAWENH(2,1) = 0.4826*Lf(2) +! folAWENH(3,1) = 0.4079*Lf(3) +! folAWENH(1,2) = 0.1773*Lf(1) +! folAWENH(2,2) = 0.1317*Lf(2) +! folAWENH(3,2) = 0.198*Lf(3) +! folAWENH(1,3) = 0.0887*Lf(1) +! folAWENH(2,3) = 0.0658*Lf(2) +! folAWENH(3,3) = 0.099*Lf(3) +! folAWENH(1,4) = 0.216*Lf(1) +! folAWENH(2,4) = 0.3199*Lf(2) +! folAWENH(3,4) = 0.2951*Lf(3) +! END SUBROUTINE foliageAWENH + +!! Branches are here +!! It seems that there is only valiues for pine (these are applied for others as well) +! SUBROUTINE branchesAWENH(Lb, fbAWENH) +! IMPLICIT NONE +! INTEGER,PARAMETER :: n = 5, nSp=3 +! REAL (kind=8),DIMENSION(nSp,n),INTENT(OUT) :: fbAWENH +! REAL (kind=8),DIMENSION(nSp),INTENT(IN) :: Lb +!! fbAWENH = 0. +! fbAWENH(:,1) = 0.47466*Lb +! fbAWENH(:,2) = 0.019012*Lb +! fbAWENH(:,3) = 0.078308*Lb +! fbAWENH(:,4) = 0.430248*Lb +! END SUBROUTINE branchesAWENH + + +! SUBROUTINE stemAWENH(Lst, stAWENH) +! IMPLICIT NONE +! INTEGER,PARAMETER :: n = 5, nSp=3 +! REAL (kind=8),DIMENSION(nSp,n),INTENT(OUT) :: stAWENH +! REAL (kind=8),DIMENSION(nSp),INTENT(IN) :: Lst +!! stAWENH = 0. +! stAWENH(1,1) = 0.5*(0.66+0.68)*Lst(1) +! stAWENH(2,1) = 0.5*(0.63+0.7)*Lst(2) +! stAWENH(3,1) = 0.5*(0.65+0.78)*Lst(3) +! stAWENH(1,2) = 0.5*(0.03+0.015)*Lst(1) +! stAWENH(2,2) = 0.5*(0.03+0.005)*Lst(2) +! stAWENH(3,2) = 0.5*(0.03+0)*Lst(3) +! stAWENH(1,3) = 0.5*(0+0.015)*Lst(1) +! stAWENH(2,3) = 0.5*(0+0.005)*Lst(2) +! stAWENH(3,3) = 0 +! stAWENH(1,4) = 0.5*(0.28+0.29)*Lst(1) +! stAWENH(2,4) = 0.5*(0.33+0.28)*Lst(2) +! stAWENH(3,4) = 0.5*(0.22+0.33)*Lst(3) +! END SUBROUTINE stemAWENH + + diff --git a/src/B_prebas_v0.f90 b/src/B_prebas_v0.f90 new file mode 100644 index 0000000..df4311c --- /dev/null +++ b/src/B_prebas_v0.f90 @@ -0,0 +1,1089 @@ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!subroutine bridging +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine prebas_v0(nYears,nLayers,nSp,siteInfo,pCrobas,initVar,thinning,output,nThinning,maxYearSite,fAPAR,initClearcut,& + fixBAinitClarcut,initCLcutRatio,ETSy,P0y,weatherPRELES,DOY,pPRELES,etmodel, soilCinOut,pYasso,pAWEN,weatherYasso,& + litterSize,soilCtotInOut,& + defaultThin,ClCut,inDclct,inAclct,dailyPRELES,yassoRun) + +implicit none + + integer, parameter :: nVar=46,npar=37, inttimes = 1!, nSp=3 + real (kind=8), parameter :: pi = 3.1415927, t=1. + ! logical steadystate_pred= .false. +!define arguments + integer, intent(in) :: nYears,nLayers,nSp + real (kind=8), intent(in) :: weatherPRELES(nYears,365,5) + integer, intent(in) :: DOY(365),etmodel + real (kind=8), intent(inout) :: pPRELES(30) + real (kind=8), intent(inout) :: thinning(nThinning,8) + real (kind=8), intent(inout) :: initClearcut(5) !initial stand conditions after clear cut. (H,D,totBA,Hc,Ainit) + real (kind=8), intent(in) :: pCrobas(npar,nSp),pAWEN(12,nSp) + integer, intent(in) :: maxYearSite + real (kind=8), intent(in) :: defaultThin,ClCut,yassoRun,fixBAinitClarcut + real (kind=8), intent(in) :: inDclct(nSp),inAclct(nSp) +! integer, intent(in) :: siteThinning(nSites) + integer, intent(inout) :: nThinning + real (kind=8), intent(out) :: fAPAR(nYears) + real (kind=8), intent(inout) :: dailyPRELES((nYears*365),3) + real (kind=8), intent(in) :: initVar(6,nLayers),P0y(nYears),ETSy(nYears),initCLcutRatio(nLayers)! + real (kind=8), intent(inout) :: siteInfo(7) + real (kind=8), intent(out) :: output(nYears,nVar,nLayers,2) + real (kind=8), intent(inout) :: soilCinOut(nYears,5,3,nLayers),soilCtotInOut(nYears) !dimensions = nyears,AWENH,treeOrgans(woody,fineWoody,Foliage),species + real (kind=8), intent(inout) :: pYasso(35), weatherYasso(nYears,3),litterSize(3,nSp) !litterSize dimensions: treeOrgans,species + real (kind=8) :: prelesOut(16),fAPARsite + real (kind=8) :: leac=0 !leaching parameter for Yasso + real (kind=8),DIMENSION(nLayers,5) :: fbAWENH,folAWENH,stAWENH + real (kind=8),DIMENSION(nLayers) :: Lb,Lf,Lst +! real (kind=8),DIMENSION(nLayers) :: speciesIDs + + real (kind=8) :: STAND(nVar),STAND_tot(nVar),param(npar)!, output(nYear,nSites,nVar) + integer :: i, ij, ijj,species,layer,nSpec,ll! tree species 1,2,3 = scots pine, norway spruce, birch + + real (kind=8) :: p0_ref, ETS_ref + integer :: time, ki, year,yearX,Ainit, countThinning,domSp(1) + real (kind=8) :: step, totBA + + real (kind=8) :: stand_all(nVar,nLayers) + real (kind=8) :: outt(nVar,nLayers,2) + real (kind=8) :: modOut((nYears+1),nVar,nLayers,2) + real (kind=8) :: soilC((nYears+1),5,3,nLayers),soilCtot((nYears+1)) + real (kind=8) :: par_phib,par_phic,par_alfat,par_alfar1,par_alfar2,par_alfar3,par_alfar4 + real (kind=8) :: par_alfar5,par_etab,par_k,par_vf,par_vr,par_sla,par_mf,par_mr,par_mw,par_vf0 + real (kind=8) :: par_z,par_rhos,par_cR, par_x, Light,MeanLight(nLayers),par_mf0,par_mr0,par_mw0 + real (kind=8) :: par_sarShp, par_S_branchMod + real (kind=8) :: par_rhof, par_rhor, par_rhow, par_c, par_beta0, par_betab, par_betas + real (kind=8) :: par_s1, par_p0, par_ksi, par_cr2,par_kRein,Rein, c_mort + real (kind=8) :: BA, dA, dB, reineke, dN, wf_test,par_thetaMax, par_Age0, par_gamma + real (kind=8) :: par_rhof0, par_rhof1, par_rhof2, par_aETS,dHcCum,dHCum,pars(30) + +!management routines + real (kind=8) :: A_clearcut, D_clearcut, BAr(nLayers), BA_tot,BA_lim, BA_thd, ETSthres = 1000 + +!define varibles + real (kind=8) :: LAT, LONG, sitetype, P0, age, meantemp, mintemp, maxtemp, rainfall, ETS + real (kind=8) :: H, D, B, Hc, Cw, Lc, N, Ntree, Ntot,dNtot + real (kind=8) :: wf_treeKG, wf_STKG, sar_con, sar_ell, rc, ppow, sar,W_stem + real (kind=8) :: lproj, leff,laPer_sar, keff, slc + real (kind=8) :: hb, A, B2,beta0, beta1,beta2, betas, betab + real (kind=8) :: c,dHc,dH,dLc,g0,g1,g2,g3,g4,g5 + real (kind=8) :: npp, p_eff_all + real (kind=8) :: p_eff, par_alfar,p + real (kind=8) :: s0,par_s0scale + real (kind=8) :: weight, dNp,dNb,dNs + real (kind=8) :: W_wsap, respi_m, respi_tot, V_scrown, V_bole, V,Vold + real (kind=8) :: coeff(nLayers), denom,W_froot,W_croot, lit_wf,lit_froot + real (kind=8) :: S_wood,Nold, Nthd, RelSize_thinTree,S_branch,S_fol,S_fr,W_branch + real (kind=8) :: W_stem_old,wf_treeKG_old + +!fix parameters + real (kind=8) :: qcTOT0,Atot,fAPARprel(365) + + ! open(2,file="test.txt") + ! write(2,*) "site = ",siteInfo(1) +!###initialize model###! +fbAWENH = 0. +folAWENH = 0. +stAWENH = 0. +yearX = 0 +modOut = 0. +soilC = 0. +countThinning = 1 +pars = pPRELES +soilC(1,:,:,:) = soilCinout(1,:,:,:) +pars(24) = siteInfo(4)!SWinit +pars(25) = siteInfo(5)!CWinit +pars(26) = siteInfo(6) !SOGinit +pars(27) = siteInfo(7) !Sinit + + + do i = 1,nLayers + modOut(:,4,i,1) = initVar(1,i) ! assign species + modOut(:,7,i,1) = initVar(2,i) ! assign initAge !age can be made species specific assigning different ages to different species + modOut(1,39,i,1) = sum(soilC(1,:,:,i)) !assign initial soilC + modOut(:,5,i,1) = ETSy ! assign ETS + modOut(:,6,i,1) = P0y ! assign P0 + enddo + modOut(:,1,:,1) = siteInfo(1); modOut(:,2,:,1) = siteInfo(2) !! assign siteID and climID + modOut(1,11,:,1) = initVar(3,:) + modOut(1,12,:,1) = initVar(4,:) + modOut(1,13,:,1) = initVar(5,:) + modOut(1,14,:,1) = initVar(6,:) + modOut(1,17,:,1) = modOut(1,13,:,1)/(pi*((modOut(1,12,:,1)/2/100)**2)) + modOut(1,35,:,1) = modOut(1,13,:,1)/modOut(1,17,:,1) + modOut(:,3,:,1) = siteInfo(3);sitetype = siteInfo(3)! assign site type + soilCtot(1) = sum(soilC(1,:,:,:)) !assign initial soilC + +!######! + +do year = 1, (nYears) + + + if(year==int(min(yearX,nYears))) then + Ainit = int(min(Ainit, Ainit + nYears - yearX)) + totBA = sum(modOut((year-Ainit-1),13,:,1)) + do ijj = 1,nLayers + if(fixBAinitClarcut==1) then + modOut(year,13,ijj,1) = initClearcut(3) * initCLcutRatio(ijj) + else + modOut(year,13,ijj,1) = initClearcut(3) * modOut((year-Ainit-1),13,ijj,1)/ totBA + endif + modOut(year,11,ijj,1) = initClearcut(1) + modOut(year,12,ijj,1) = initClearcut(2) + modOut(year,14,ijj,1) = initClearcut(4) + modOut(year,17,ijj,1) = modOut(year,13,ijj,1)/(pi*((modOut(year,12,ijj,1)/2/100)**2)) + modOut(year,35,ijj,1) = modOut(year,13,ijj,1) / modOut(year,17,ijj,1) + enddo + do ki = 1,int(Ainit) + do ijj = 1,nLayers + modOut((year-Ainit+ki),7,ijj,1) = ki !#!# + modOut((year-Ainit+ki),4,ijj,1) = initVar(1,ijj) !#!# + enddo + enddo + yearX = 0 + endif + + stand_all = modOut(year,:,:,1) + + step = 1. / float(inttimes) + outt(:,:,2) = 0. + + !---------------------------------- + !PHOTOSYNTHESIS MODEL PART 1 + !---------------------------------- + + do time = 1, inttimes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! do ki = 1, nSites + ! calculate self-thinning using all tree classes + Ntot = sum(STAND_all(17,:)) + B = sum(STAND_all(35,:)*STAND_all(17,:))/Ntot !!!!!!!!!#####changed + if(Ntot>0.) then + Reineke = Ntot*(sqrt(B*4/pi)*100./25.)**(1.66) + else + Reineke = 0. + endif + ! end do + +do ij = 1 , nLayers !loop Species + + ! write(2,*) "nLayers",ij, "of", nLayers,"year=",year + + STAND=STAND_all(:,ij) + species = int(stand(4)) + param = pCrobas(:,species) + + par_cR=param(1) + par_rhow=param(2) + par_sla =param(3) + par_k =param(4) + par_vf0 =param(5) + par_vr =param(6) + par_c=param(7) + par_mf0=param(8) + par_mr0=param(9) + par_mw0=param(10) + par_z=param(11) + par_beta0=param(12) + par_betab=param(13) + par_betas = param(14) + par_rhof2 = param(15) + par_s1 = param(16) + par_kRein = param(17) + par_s0scale = param(18) + par_x = param(19) + par_aETS = param(20) + par_alfar1 =param(21) + par_alfar2 =param(22) + par_alfar3 =param(23) + par_alfar4 = param(24) + par_alfar5 = param(25) + par_sarShp = param(26) !Shape surface area of the crown: 1.= cone; 2.=ellipsoide + par_S_branchMod = param(27) !model for branch litter model + p0_ref = param(29) + ETS_ref = param(30) + par_thetaMax = param(31) + par_Age0 = param(32) + par_gamma = param(33) + par_rhof1 = 0.!param(20) + par_Cr2 = 0.!param(24) + + +! do siteNo = 1, nSites !loop sites + +if (year > maxYearSite) then + STAND(8:21) = 0. !#!# + STAND(23:37) = 0. !#!# + STAND(42:44) = 0. !#!# + +else +! initialize site variables +! sitetype = STAND(3) + + age = STAND(7) + H = STAND(11) + D = STAND(12) + BA = STAND(13) + Hc = STAND(14) + N = BA/(pi*((D/2/100)**2)) + B = BA/N! * par_ops2 +! Cw = STAND(15) + Lc = H - Hc + hb = par_betab * Lc ** par_x + Cw = 2. * hb + STAND(15) = Cw + STAND(16) = LC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!TO CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!! + ETS = STAND(5) !!##!!2 + Light = STAND(36) + +!!compute V for the first year + +if (N>0.) then + + par_rhof0 = par_rhof1 * ETS_ref + par_rhof2 + par_rhof = par_rhof1 * ETS + par_rhof2 + par_vf = par_vf0 / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) +! par_vr = par_vr / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) + + !calculate derived variables + rc = Lc / (H-1.3) !crown ratio + A = rc * B + wf_treeKG = par_rhof * A + par_ksi = wf_treeKG / (Lc ** par_z) + wf_STKG = wf_treeKG * N !needle mass per STAND in units C + ppow=1.6075 + + V_scrown = A * (par_betas*Lc) + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 + V = (V_scrown + V_bole) * N + if(year==1) then + modOut(year,30,ij,1) = V + endif + + !Surface area of the crown + sar_ell= 4. * pi * (((((Lc/2)**ppow)*((Cw/2)**ppow)+((Lc/2)**ppow)*((Cw/2)**ppow)+((Cw/2)**ppow)*((Cw/2)**ppow))/3)**(1/ppow))!surface area per tree + sar_con = pi * ((0.8*hb)**2) * (1 + sqrt(1 + 1 / (((0.8*hb) / Lc)**2))) !surface area per tree + !Ellipsoid for pine and birch, cone for spruce + if(par_sarShp==1.) then + sar = sar_ell + else + sar = sar_con + slc = 0.005 + end if + + !specific leaf area ------------------------------------------------ + laPer_sar = wf_treeKG * par_sla / sar !leaf area per tree / crown surface area + keff = 0.4 * (1. - exp( - par_k / 0.4 * laPer_sar)) / laPer_sar !effective extinction coefficient } + !projected leaf area on the STAND ----------------------------------- + if (wf_STKG>0.) then + lproj = par_sla * wf_STKG / 10000. + else + lproj = 0. + end if + !weight per tree STAND$species stratum ------------------------------------ + leff= (keff/par_k)*(wf_STKG*par_sla) / 10000. !effective lai + + STAND(7) = age + STAND(19) = leff + STAND(20) = keff + STAND(21) = lproj + STAND(23) = weight + STAND(24) = W_branch + STAND(25) = W_froot + STAND(11) = H + STAND(12) = D + STAND(13) = BA ! * par_ops2 + STAND(14) = Hc + STAND(15) = Cw + STAND(17) = N + STAND(33) = wf_STKG + STAND(34) = wf_treeKG + STAND(35) = B + STAND(30) = V +else + STAND(8:21) = 0. !#!# + STAND(23:37) = 0. !#!# + STAND(42:44) = 0. !#!# +endif +endif +! end do !!!!!!!end loop sites + + STAND_all(:,ij)=STAND +end do !!!!!!!end loop layers + +!!!calculate species weight for photosynthesis +!do siteNo = 1, nSites + +if (year <= maxYearSite) then + nSpec = nSp + ll = nLayers + call Ffotos2(STAND_all,nLayers,nSpec,pCrobas,& + nVar,nPar,MeanLight,coeff,fAPARsite) + STAND_all(36,:) = MeanLight + STAND_all(23,:) = coeff +! fAPARsite=0.7 + if(fAPARsite == 0. .and. yearX == 0) then + if((nYears-year)<10) then + Ainit = nint(6. + 2*3.5 - 0.005*modOut(year,5,1,1) + 2.25) + else + Ainit = nint(6. + 2*3.5 - 0.005*(sum(modOut(year:(year+9),5,1,1))/10) + 2.25) + endif + yearX = Ainit + year +! initClearcut(5) = Ainit + endif + + fAPARprel(:) = fAPARsite + fAPAR(year) = fAPARsite + call preles(weatherPRELES(year,:,:),DOY,fAPARprel,prelesOut, pars, & + dailyPRELES((1+((year-1)*365)):(365*year),1), & !daily GPP + dailyPRELES((1+((year-1)*365)):(365*year),2), & !daily ET + dailyPRELES((1+((year-1)*365)):(365*year),3), & !daily SW + etmodel) !type of ET model + + STAND_all(22,:) = prelesOut(2) !ET + STAND_all(40,:) = prelesOut(15) + STAND_all(41,:) = prelesOut(16) + + pars(24) = prelesOut(3);siteInfo(4) = prelesOut(3)!SWinit + pars(25) = prelesOut(13); siteInfo(5) = prelesOut(13) !CWinit + pars(26) = prelesOut(4); siteInfo(6) = prelesOut(4) !SOGinit + pars(27) = prelesOut(14); siteInfo(7) = prelesOut(14) !Sinit + + STAND_all(10,:) = prelesOut(1)/1000.! Photosynthesis in g C m-2 (converted to kg C m-2) + +endif +!enddo !! end site loop + +do ij = 1 , nLayers + STAND=STAND_all(:,ij) + species = int(stand(4)) + param = pCrobas(:,species) + + par_cR=param(1) + par_rhow=param(2) + par_sla =param(3) + par_k =param(4) + par_vf0 =param(5) + par_vr =param(6) + par_c=param(7) + par_mf0=param(8) + par_mr0=param(9) + par_mw0=param(10) + par_z=param(11) + par_beta0=param(12) + par_betab=param(13) + par_betas = param(14) + par_rhof2 = param(15) + par_s1 = param(16) + par_kRein = param(17) + par_s0scale = param(18) + par_x = param(19) + par_aETS = param(20) + par_alfar1 =param(21) + par_alfar2 =param(22) + par_alfar3 =param(23) + par_alfar4 =param(24) + par_alfar5 =param(25) + par_sarShp = param(26) !Shape surface area of the crown: 1.= cone; 2.=ellipsoide + par_S_branchMod = param(27) !model for branch litter model + p0_ref = param(29) + ETS_ref = param(30) + par_thetaMax = param(31) + par_Age0 = param(32) + par_gamma = param(33) + par_rhof1 = 0.!param(20) + par_Cr2 = 0.!param(24) + +! do siteNo = 1, nSites !start site loop + +if (year > maxYearSite) then + STAND(8:21) = 0. !#!# + STAND(23:37) = 0. !#!# + STAND(42:44) = 0. !#!# +else + +! initialize site variables +! sitetype = STAND(3) + age = STAND(7) + p0 = STAND(6)/1000. ! convert g C m-2 to kg C m-2 !#!# + ETS = STAND(5) + H = STAND(11) + D = STAND(12) + BA = STAND(13)! * par_ops2 + Hc = STAND(14) + Cw = STAND(15) + Lc = STAND(16) + N = STAND(17) + Lc = H - Hc + leff = STAND(19) + keff = STAND(20) + lproj = STAND(21) + p_eff_all = STAND(10) !!##!!2 + weight = STAND(23) + + rc = Lc / (H-1.3) !crown ratio + B = BA / N + A = rc * B + + wf_STKG = STAND(33) + wf_treeKG = STAND(34) + B = STAND(35) + Light = STAND(36) + hb = par_betab * Lc ** par_x + Cw = 2. * hb + +if (N>0.) then + + +!!!!###here starts stand2 subroutine!!!!!!!!!!!######### + if (sitetype <= 1.) then + par_alfar = par_alfar1 + else if (sitetype==2.) then + par_alfar = par_alfar2 + else if (sitetype==3.) then + par_alfar = par_alfar3 + else if (sitetype==4.) then + par_alfar = par_alfar4 + else + par_alfar = par_alfar5 + end if + +!relate metabolic and structural parameters to site conditions + par_mf = par_mf0 * p0 / p0_ref + par_mr = par_mr0 * p0 / p0_ref + par_mw = par_mw0 * p0 / p0_ref + + par_rhof0 = par_rhof1 * ETS_ref + par_rhof2 + par_rhof = par_rhof1 * ETS + par_rhof2 + par_vf = par_vf0 / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) +! par_vr = par_vr / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) + par_rhor = par_alfar * par_rhof + + ! ------------------------------------- + !GPP all STAND$species UNITS: g C / m2 + ! ------------------------------------- + p_eff = weight * p_eff_all + + if(wf_STKG > 0.) then + s0 = min(par_s0scale * P0 * par_k * par_sla, P_eff / wf_STKG * 10000.) + else + s0 = 0. + endif + + !--------------------------------------- + ! DYNAMIC GROWTH MODEL STARTS + !Updating the tree H, D, Hc and Cw for the next year, according to the method by Valentine & Makela (2005) + !Valentine & Makela 2005. Bridging process - based and empirical approaches to modeling tree growth. + ! HERE the units are kg / ha + + betab = hb/Lc + beta0 = par_beta0 + beta1 = beta0 * (betab + par_betas) + beta2 = beta0 - beta1 + + !Height growth----------------------- + + g0 = par_rhof * par_s1 + par_rhow * par_mw * beta1 + g1 = (1. / (1. + par_z)) * (g0 / (beta1 * par_rhow * (1. + par_c))) + g2 = ((par_rhof * (s0 - par_mf) - (par_rhor * par_mr)) / g0) - & + ((1. + par_c) / g0) * (par_rhof / par_vf + par_rhor / par_vr) + g3 = (par_z / (1. + par_z)) * ((par_rhof + par_rhor) / (par_rhow * beta1)) + g4 = 1 + (par_rhow * par_mw * beta2 - par_rhof * par_s1) / g0 + g5 = (par_z / (1. + par_z)) * (1. / (betab + par_betas)) + dH = g1 * (Lc) * ((g2 - (g4 - 1.) * (H-Lc) - H) / (g3 + (g5 - 1.) * (H-Lc) + H)) + if(dH < 0.) dH = 0. + !----------------------------------- + !crown rise +! if(H - Hc > par_Cr2*100./sqrt(N)) then +! if(2.*hb > 100./sqrt(N) ) then + dHc = par_cR/Light * dH +if(time==1)then + dHcCum = 0. + dHCum = 0. +endif + dHcCum = dHcCum + dHc + dHCum = dHCum + dH +! else +! dHc = 0 !CAN BE DIFFERENT FROM THE PAPER HARKONEN ET AL. 2013 CANADIAN JOURNAL, SEE THE EQUATION THERE +! endif + if(dHc < 0. )dHc = 0. + + !---------------------------------- + !New values for H, Hc and Lc + + ! diameter growth + + if(Lc > 0.) then + dA = par_z*A*(dH-dHc)/Lc + dB = par_z * (A / Lc) * dH + else + dA = 0. + dB = 0. + endif + +! Mortality - use Reineke from above +! if((Reineke(siteNo) > par_kRein .OR. Light < par_cR) .and. siteThinning(siteNo) == 0) then ! +! if(time==inttimes) then + Rein = Reineke / par_kRein + + if(Rein > 1.) then + dN = - 0.02 * N * Rein + else + dN = 0. + endif + Vold = STAND(30) + Nold = N + if(N < 5.) N = 0.0 + + N = max(0.0, N + step*dN) + + !!!calculate deadWood using Gompetz function (Makinen et al. 2006)!!!! + if(dN<0.) then + modOut((year+1),8,ij,1) = modOut((year+1),8,ij,1) + Vold* min(1.,-dN*step/Nold) + do ijj = 1,(nyears-year) + modOut((year+ijj+1),8,ij,1) = modOut((year+ijj+1),8,ij,1) + (Vold/Nold) * (-dN*step) * & + exp(-exp(pCrobas(34,species) + pCrobas(35,species)*ijj + pCrobas(36,species)*D + 0.)) + enddo + end if + + +!! Update state variables + + H = H + step * dH + A = A + step * dA + B = B + step * dB + + Hc = Hc + step * dHc + +! Update dependent variables + wf_treeKG = par_rhof * A + wf_STKG = N * wf_treeKG + BA = N * B + D = sqrt(B*4./pi)*100. ! * 100 converts meters in cm + Lc = H - Hc + rc = Lc / (H-1.3) + if(rc > 0.) B2 = A / rc + hb = par_betab * Lc**par_x + hb = betab * Lc + +! Here these were calculated for some reason although they were computed from hb before +! if(species==1) then +! Cw = 2*0.386*Lc**0.8268 +! else if(species==2) then +! Cw = 2*0.4614*Lc**0.5198 +! else +! Cw = 2*0.2689*Lc +! endif + +! more dependent variables (not used in calculation) + W_wsap = N * par_rhow * A * (beta1 * H + beta2 * Hc) + Respi_m = (par_mf + par_alfar*par_mr)* wf_STKG + par_mw * W_wsap +! note changes in the equations below AM 15.5.2015 + npp = (weight * p_eff_all - Respi_m / 10000.) / (1.+par_c) + Respi_tot = weight * p_eff_all - npp + V_scrown = A * (par_betas*Lc) +! note that this equation has changed AM 15.5.2015 + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 +! here the output has been changed to biomass but the name remains V AM 15.5.2015 + W_stem = (V_scrown + V_bole) * N * par_rhow + V = (V_scrown + V_bole) * N +!calculate root baiomasses and litterfall + + W_froot = par_alfar * wf_STKG !fine root biomass + W_croot = W_stem * (beta0 - 1.) !coarse root biomass + W_branch = par_rhow * A * Lc * betab * N +! ! litter fall in the absence of thinning + S_fol = wf_STKG / par_vf !foliage litterfall + S_fr = W_froot / par_vr !fine root litter +! ! branch litter fall pine from Lehtonen et al. 2004 Table 7, with impact of N on litter fall +! ! branch litter for spruce Muukkonen and Lehtonen 2004 Eqn 11 + if(par_S_branchMod .eq. 1.) then + S_branch = W_branch * ((0.0337+0.000009749*N)*exp(-0.00456*D**2)+0.00723) + else + S_branch = W_branch *((-0.00513+0.000012*N)*exp((0.00000732-0.000000764*N)*D**2)+0.00467) + endif + if (dN<0. .and. Nold>0.) then + S_branch = S_branch + W_branch * min(1.,-dN*step/N) + S_wood = (W_croot + W_stem) * min(1.,-dN*step/N) + else + S_wood = 0. + endif + + age = age + step + + STAND(7) = age !#!# + STAND(18) = npp + !STAND(8) = Respi_m /10000. + STAND(9) = Respi_tot + STAND(11) = H + STAND(12) = D + STAND(13) = BA + STAND(14) = Hc + STAND(15) = Cw + STAND(16) = Lc + STAND(17) = N + STAND(24) = W_branch + STAND(25) = W_froot + STAND(26) = S_fol + STAND(27) = S_fr + STAND(28) = S_branch + STAND(29) = S_wood + STAND(30) = V + STAND(31) = W_stem + STAND(32) = W_croot + STAND(33) = wf_STKG + STAND(34) = wf_treeKG + STAND(35) = B + STAND(36) = Light + STAND(42) = Vold* min(1.,-dN*step/Nold) + STAND(44) = p_eff +else + STAND(8:21) = 0. !#!# + STAND(23:37) = 0. !#!# + STAND(42:44) = 0. !#!# + STAND(7) = STAND(7) + step +endif +endif + + + !Perform manual thinning or defoliation events for this time period +! If (STAND(13) > 0) then + If (countThinning <= nThinning .and. time==inttimes) Then + If (year == int(thinning(countThinning,1)) .and. ij == int(thinning(countThinning,3))) Then! .and. siteNo == thinning(countThinning,2)) Then + STAND_tot = STAND + +! STAND(11) = + if(thinning(countThinning,4)==0.) then + STAND(8:21) = 0. !#!# + STAND(23:37) = 0. !#!# + STAND(43:44) = 0. !#!# + !! calculate litter including residuals from thinned trees + S_fol = wf_STKG + S_fr = W_froot + S_branch = W_branch + S_wood = S_wood + W_stem* 0.1 + W_croot !0.1 takes into account of the stem residuals after thinnings + STAND(26) = S_fol + STAND(27) = S_fr + STAND(28) = S_branch + STAND(29) = S_wood + else + if(thinning(countThinning,8)==1.) then + if(thinning(countThinning,4) < 2. .and. thinning(countThinning,4) > 0.) then + thinning(countThinning,4) = H * thinning(countThinning,4) + endif + if(thinning(countThinning,5) < 2. .and. thinning(countThinning,5) > 0.) then + thinning(countThinning,5) = D * thinning(countThinning,5) + endif + if(thinning(countThinning,6) < 1. .and. thinning(countThinning,6) > 0.) then + thinning(countThinning,6) = BA * thinning(countThinning,6) + endif + if(thinning(countThinning,7) < 2. .and. thinning(countThinning,7) > 0.) then + thinning(countThinning,7) = Hc * thinning(countThinning,7) + endif + endif + if (thinning(countThinning,4) /= -999.) H = thinning(countThinning,4) + if (thinning(countThinning,7) /= -999.) Hc = thinning(countThinning,7) + if (thinning(countThinning,5) /= -999.) D = thinning(countThinning,5) + BA = thinning(countThinning,6) + Lc = H - Hc !Lc + rc = Lc / (H-1.3) !crown ratio + Nold = N + wf_treeKG_old = wf_treeKG + W_stem_old = W_stem + N = BA/(pi*((D/2./100.)**2.)) ! N + Nthd = Nold-N ! number of cutted trees + B = BA/N!(pi*((D/2/100)**2)) + A = rc * B + wf_treeKG = par_rhof * A + + V_scrown = A * (par_betas*Lc) + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 + W_stem = (V_scrown + V_bole) * N * par_rhow + RelSize_thinTree = (W_stem/N)/(W_stem_old/Nold) + V = (V_scrown + V_bole) * N + wf_STKG = N * wf_treeKG + hb = par_betab * Lc ** par_x + Cw = 2 * hb +!! calculate litter including residuals from thinned trees + S_fol = S_fol + wf_treeKG_old * Nthd + S_fr = S_fr + W_froot * Nthd/Nold + S_branch = S_branch + W_branch * Nthd/Nold + S_wood = S_wood + (W_stem_old*0.1 + W_croot) * Nthd/Nold +!!update biomasses + W_froot = par_alfar * wf_STKG !fine root biomass + W_croot = W_stem * (beta0 - 1.) !coarse root biomass + W_branch = par_rhow * A * Lc * betab * N + + outt(11,ij,2) = STAND_tot(11) + outt(12,ij,2) = STAND_tot(12) + outt(13,ij,2) = STAND_tot(13) - BA + outt(14,ij,2) = STAND_tot(14) + outt(15,ij,2) = STAND_tot(15) + outt(16,ij,2) = STAND_tot(16) + outt(17,ij,2) = Nthd + outt(18:23,ij,2) = -999. + outt(24,ij,2) = STAND_tot(24) - W_branch + outt(25,ij,2) = STAND_tot(25) - W_froot + outt(26:29,ij,2) = -999. + outt(30,ij,2) = STAND_tot(30) - V + outt(31,ij,2) = STAND_tot(31) - W_stem + outt(32,ij,2) = Nthd * W_croot/N + outt(33,ij,2) = STAND_tot(33) - wf_STKG + outt(34,ij,2) = (STAND_tot(34)*Nold - wf_treeKG*N)/Nthd + outt(35,ij,2) = -999.; outt(36,ij,2)= -999. + + STAND(11) = H + STAND(12) = D + STAND(13) = BA + STAND(14) = Hc ! stand Hc + STAND(15) = Cw + STAND(16) = Lc ! stand Lc + STAND(17) = N + STAND(26) = S_fol + STAND(27) = S_fr + STAND(28) = S_branch + STAND(29) = S_wood + STAND(30) = V ! + STAND(31) = W_stem + STAND(32) = W_croot + STAND(33) = wf_STKG + STAND(34) = wf_treeKG + STAND(35) = B + endif + + countThinning = countThinning + 1 + + End If + End If + + STAND_all(:,ij)=STAND +end do !!!!end loop species + end do !!!!end loop inttimes + + +!Perform thinning or defoliation events for this time period using standard management routines!!!!!!!!!!!!!!!! +!do siteNo = 1, nSites + ! write(2,*) "before clcut" + +!!!!test for clearcut!!!! + domSp = maxloc(STAND_all(13,:)) + layer = int(domSp(1)) +if (ClCut == 1.) then + species = int(stand_all(4,layer)) + D_clearcut = inDclct(species) + A_clearcut = inAclct(species) + D = stand_all(12,layer) + age = stand_all(7,layer) + + if ((D > D_clearcut) .or. (age > A_clearcut)) then + do ij = 1, nLayers + outt(6:nVar,ij,2) = stand_all(6:nVar,ij) + S_fol = stand_all(33,ij) + stand_all(26,ij) + S_fr = stand_all(25,ij) + stand_all(27,ij) + S_branch = stand_all(24,ij) + stand_all(28,ij) + S_wood = stand_all(31,ij)* 0.1 + stand_all(32,ij) + stand_all(29,ij) !0.1 takes into account of the stem residuals after clearcuts + stand_all(8:21,ij) = 0. + stand_all(23:37,ij) = 0. + stand_all(43:44,ij) = 0. + stand_all(26,ij) = S_fol + stand_all(27,ij) = S_fr + stand_all(28,ij) = S_branch + stand_all(29,ij) = S_wood +!!update age + ! do ki = 1, min(20,(nyears-year)) + ! modOut((year+ki),7,ij,1) = ki !#!# + ! modOut((year+ki),4,ij,1) = initVar(1,ij) !#!# + ! enddo + + enddo + endif +endif + +! write(2,*) "befire thinnings after CLCUT" + +!!!!test for thinnings!!!! + !!!!!!!for coniferous dominated stands!!!!!! +if(defaultThin == 1.) then +! sitetype = siteInfo(3) + BA_tot = sum(stand_all(13,:))!+stand_all(13,2)+stand_all(13,3) + BAr = stand_all(13,:)/BA_tot +! BAr_SP = stand_all(13,2)/BA_tot +! BAr_B = stand_all(13,3)/BA_tot + BA_lim = 9999999999.9 + BA_thd = 0. + domSp = maxloc(STAND_all(13,:)) + layer = int(domSp(1)) + H = stand_all(11,layer) + if(H>12.) then + species = int(stand_all(4,layer)) + if(pCrobas(28,species)==1.) then + if(sitetype < 3.) then + if(H<20.) then + BA_lim = -0.0893*H**2. + 4.0071*H - 11.343 + BA_thd = -0.0536*H**2. + 2.7643*H - 9.6857 + else + BA_lim = 33. + BA_thd = 24. + endif + endif + if(sitetype == 3.) then + if(H<20.) then + BA_lim = -0.125*H**2. + 4.95*H - 20.9 + BA_thd = -0.1071*H**2. + 3.9286*H - 15.771 + else + BA_lim = 28. + BA_thd = 20. + endif + endif + if(sitetype == 4.) then + if(H<20.) then + BA_lim = -0.1071*H**2. + 4.2286*H - 15.571 + BA_thd = -0.0714*H**2. + 2.7857*H - 9.1143 + else + BA_lim = 26. + BA_thd = 18. + endif + endif + if(sitetype >= 5.) then + if(H<20.) then + BA_lim = -0.0714*H**2. + 2.9857*H - 7.9143 + BA_thd = -0.0714*H**2. + 2.7857*H - 11.114 + else + BA_lim = 23. + BA_thd = 16. + endif + endif +!!!!!!!for decidous dominated stands!!!!!! + elseif(pCrobas(28,species)==2.) then + if(H<20.) then + BA_lim = -0.0179*H**2. + 1.2214*H + 3.7714 + BA_thd = -0.0536*H**2. + 2.4643*H - 12.886 + else + BA_lim = 21. + BA_thd = 15. + endif + endif + endif + if (BA_tot > BA_lim) then + do ij = 1, nLayers +!ij=1 + if(stand_all(17,ij)>0.) then + STAND_tot = stand_all(:,ij) + species = int(stand_all(4,ij)) + param = pCrobas(:,species) + par_cR=param(1) + par_rhow=param(2) + par_sla =param(3) + par_k =param(4) + par_vf0 =param(5) + par_vr =param(6) + par_c=param(7) + par_mf0=param(8) + par_mr0=param(9) + par_mw0=param(10) + par_z=param(11) + par_beta0=param(12) + par_betab=param(13) + par_betas = param(14) + par_rhof2 = param(15) + par_s1 = param(16) + par_kRein = param(17) + par_s0scale = param(18) + par_x = param(19) + par_aETS = param(20) + par_alfar1 =param(21) + par_alfar2 =param(22) + par_alfar3 =param(23) + par_alfar4 =param(24) + par_alfar5 =param(25) + par_sarShp = param(26) !Shape surface area of the crown: 1.= cone; 2.=ellipsoide + par_S_branchMod = param(27) !model for branch litter model + p0_ref = param(29) + ETS_ref = param(30) + par_thetaMax = param(31) + par_Age0 = param(32) + par_gamma = param(33) + par_rhof1 = 0.!param(20) + par_Cr2 = 0.!param(24) + par_rhof = par_rhof1 * stand_all(5,ij) + par_rhof2 + BA_tot = BA_thd + BA = BAr(ij) * BA_thd + if(par_sarShp==1.) then + H = stand_all(11,ij) * (1.2147-0.2086 * (BA/ stand_all(13,ij))) + D = stand_all(12,ij) * (1.2192 -0.2173 * (BA/ stand_all(13,ij))) + else + H = stand_all(11,ij) * (1.07386 -0.06553 * (BA/ stand_all(13,ij))) + D = stand_all(12,ij) * (1.1779 -0.1379 * (BA/ stand_all(13,ij))) + endif + stand_all(13,ij) = BA + Nold = stand_all(17,ij) + N = BA/(pi*((D/2./100.)**2.)) + Nthd = Nold - N + Hc = stand_all(14,ij) + Lc = H - Hc !Lc + rc = Lc / (H-1.3) !crown ratio + wf_treeKG_old = stand_all(34,ij) + W_stem_old = stand_all(31,ij) + B = BA/N + A = rc * B + wf_treeKG = par_rhof * A + V_scrown = A * (par_betas*Lc) + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 + W_stem = (V_scrown + V_bole) * N * par_rhow + V = (V_scrown + V_bole) * N + ! outt(30,ij,2) = outt(30,ij,2) - V + wf_STKG = N * wf_treeKG + hb = par_betab * Lc ** par_x + betab = hb/Lc + + Cw = 2. * hb +!! calculate litter including residuals from thinned trees + S_fol = stand_all(26,ij) + wf_treeKG_old * Nthd + S_fr = stand_all(27,ij) + stand_all(25,ij) * Nthd/Nold + S_branch = stand_all(28,ij) + stand_all(24,ij) * Nthd/Nold + S_wood = stand_all(29,ij) + (W_stem_old*0.1 + stand_all(32,ij)) * Nthd/Nold +!!update biomasses + if (sitetype <= 1.) then + par_alfar = par_alfar1 + else if (sitetype==2.) then + par_alfar = par_alfar2 + else if (sitetype==3.) then + par_alfar = par_alfar3 + else if (sitetype==4.) then + par_alfar = par_alfar4 + else + par_alfar = par_alfar5 + end if + + W_froot = par_alfar * wf_STKG !fine root biomass + W_croot = W_stem * (par_beta0 - 1.) !coarse root biomass + W_branch = par_rhow * A * Lc * betab * N + + outt(11,ij,2)= STAND_tot(11) + outt(12,ij,2)= STAND_tot(12) + outt(13,ij,2)= STAND_tot(13) - BA + outt(14,ij,2)= STAND_tot(14) + outt(15,ij,2)= STAND_tot(15) + outt(16,ij,2)= STAND_tot(16) + outt(17,ij,2)= Nthd + outt(18:23,ij,2)= -999. + outt(24,ij,2)= STAND_tot(24) - W_branch + outt(25,ij,2)= STAND_tot(25) - W_froot + outt(26:29,ij,2)= -999. + outt(30,ij,2)= STAND_tot(30) - V + outt(31,ij,2)= STAND_tot(31) - W_stem + outt(32,ij,2)= Nthd * W_croot/N + outt(33,ij,2)= STAND_tot(33) - wf_STKG + outt(34,ij,2)= (STAND_tot(34)*Nold - wf_treeKG*N)/Nthd + outt(35,ij,2)= -999.; outt(36,ij,2)= -999. + + stand_all(11,ij) = H + stand_all(12,ij) = D + stand_all(13,ij) = BA + stand_all(17,ij) = N + stand_all(26,ij) = S_fol + stand_all(27,ij) = S_fr + stand_all(28,ij) = S_branch + stand_all(29,ij) = S_wood + stand_all(24,ij) = W_branch + stand_all(25,ij) = W_froot + stand_all(30,ij) = V ! + stand_all(31,ij) = W_stem + stand_all(32,ij) = W_croot + stand_all(33,ij) = wf_STKG + stand_all(34,ij) = wf_treeKG + stand_all(35,ij) = B + endif + enddo + endif +endif !default thin + ! write(2,*) "after thinnings" + +outt(:,:,1)=STAND_all + +modOut((year+1),7,:,:) = outt(7,:,:) +modOut((year+1),9:nVar,:,:) = outt(9:nVar,:,:) + +!!!!run Yasso + ! write(2,*) "before yasso" + + if(yassoRun==1.) then + do ijj = 1, nLayers + Lst(ijj) = outt(29,ijj,1) + Lb(ijj) = outt(28,ijj,1) + Lf(ijj) = outt(26,ijj,1)+outt(27,ijj,1) + + species = int(initVar(1,ijj)) + call compAWENH(Lf(ijj),folAWENH(ijj,:),pAWEN(1:4,species)) !!!awen partitioning foliage + call compAWENH(Lb(ijj),fbAWENH(ijj,:),pAWEN(5:8,species)) !!!awen partitioning branches + call compAWENH(Lst(ijj),stAWENH(ijj,:),pAWEN(9:12,species)) !!!awen partitioning stems + + call mod5c(pYasso,t,weatherYasso(year,:),soilC((year),:,1,ijj),stAWENH(ijj,:),litterSize(1,species), & + leac,soilC((year+1),:,1,ijj),0.) + call mod5c(pYasso,t,weatherYasso(year,:),soilC((year),:,2,ijj),fbAWENH(ijj,:),litterSize(2,species), & + leac,soilC((year+1),:,2,ijj),0.) + call mod5c(pYasso,t,weatherYasso(year,:),soilC((year),:,3,ijj),folAWENH(ijj,:),litterSize(3,species), & + leac,soilC((year+1),:,3,ijj),0.) + enddo + ! write(2,*) "after yasso" + + soilCtot(year+1) = sum(soilC(year+1,:,:,:)) + ! write(*,*) soilCtot(year+1) + endif !end yassoRun if +enddo !end year loop + +! write(2,*) "after loop years" + +!soil and harvested volume outputs +modOut(:,37,:,1) = modOut(:,30,:,2) + +do year = 1,(nYears+1) + do ijj = 1, nLayers + ! modOut(year,38,ijj,1) = sum(modOut(1:year,30,ijj,2)) + & + ! sum(modOut(1:year,42,ijj,1)) + modOut(year,30,ijj,1) + modOut(year,39,ijj,1) = sum(soilC(year,:,:,ijj)) + modOut(year,38,ijj,1) = pCrobas(2,int(modOut(year,4,ijj,1))) * modOut(year,37,ijj,1) + if(year > 1.5) then + !compute gross growth + modOut(year,43,ijj,1) = modOut(year,30,ijj,1) - modOut((year-1),30,ijj,1) + & + modOut(year,42,ijj,1) + modOut(year,37,ijj,1) + endif + ! write(*,*) modOut(year,39,ijj,1) + enddo +enddo + + + + ! write(2,*) "here2" + +!compute fluxes in g C m−2 day−1 + modOut(:,44,:,1) = modOut(:,44,:,1)*1000. !*1000 coverts units to g C m−2 y−1 + modOut(:,9,:,1) = modOut(:,9,:,1)*1000. !*1000 coverts units to g C m−2 y−1 + modOut(:,18,:,1) = modOut(:,18,:,1)*1000. !*1000 coverts units to g C m−2 y−1 + + ! write(2,*) "here3" + + modOut(2:(nYears+1),45,:,1) = modOut(1:(nYears),39,:,1)/10. - modOut(2:(nYears+1),39,:,1)/10. + & !/10 coverts units to g C m−2 y−1 + modOut(2:(nYears+1),26,:,1)/10. + modOut(2:(nYears+1),27,:,1)/10. + & + modOut(2:(nYears+1),28,:,1)/10. + modOut(2:(nYears+1),29,:,1)/10. + + ! write(2,*) "here4" + +modOut(:,46,:,1) = modOut(:,44,:,1) - modOut(:,9,:,1) - modOut(:,45,:,1) + +! write(2,*) "here5" + + output = modOut(2:(nYears+1),:,:,:) + output(:,5:6,:,:) = modOut(1:(nYears),5:6,:,:) + soilCinOut = soilC(2:(nYears+1),:,:,:) + soilCtotInOut = soilCtot(2:(nYears+1)) + + ! write(2,*) "end" + ! close(2) + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + diff --git a/src/B_prebas_v1.f90 b/src/B_prebas_v1.f90 new file mode 100644 index 0000000..dd0a5d7 --- /dev/null +++ b/src/B_prebas_v1.f90 @@ -0,0 +1,1025 @@ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!subroutine bridging +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine prebas_v1(nYears,nLayers,nSp,siteInfo,pCrobas,initVar,thinning,output,nThinning,maxYearSite,fAPAR,initClearcut,& + ETSy,P0y,weatherPRELES,DOY,pPRELES,etmodel, soilCinOut,pYasso,pAWEN,weatherYasso,litterSize,soilCtotInOut,& + defaultThin,ClCut,inDclct,inAclct,dailyPRELES,yassoRun) + +implicit none + + integer, parameter :: nVar=46,npar=33, inttimes = 1!, nSp=3 + real (kind=8), parameter :: pi = 3.1415927, t=1.,steadystate_pred=0. +!define arguments + integer, intent(in) :: nYears,nLayers,nSp + real (kind=8), intent(in) :: weatherPRELES(nYears,365,5) + integer, intent(in) :: DOY(365),etmodel + real (kind=8), intent(inout) :: pPRELES(30) + real (kind=8), intent(inout) :: thinning(nThinning,8) + real (kind=8), intent(inout) :: initClearcut(5) !initial stand conditions after clear cut. (H,D,totBA,Hc,Ainit) + real (kind=8), intent(in) :: pCrobas(npar,nSp),pAWEN(12,nSp) + integer, intent(in) :: maxYearSite + real (kind=8), intent(in) :: defaultThin,ClCut,yassoRun + real (kind=8), intent(in) :: inDclct(nSp),inAclct(nSp) +! integer, intent(in) :: siteThinning(nSites) + integer, intent(inout) :: nThinning + real (kind=8), intent(out) :: fAPAR(nYears) + real (kind=8), intent(inout) :: dailyPRELES((nYears*365),3) + real (kind=8), intent(in) :: initVar(6,nLayers),P0y(nYears),ETSy(nYears)! + real (kind=8), intent(inout) :: siteInfo(7) + real (kind=8), intent(out) :: output(nYears,nVar,nLayers,2) + real (kind=8), intent(inout) :: soilCinOut(nYears,5,3,nLayers),soilCtotInOut(nYears) !dimensions = nyears,AWENH,treeOrgans(woody,fineWoody,Foliage),species + real (kind=8), intent(in) :: pYasso(35), weatherYasso(nYears,3),litterSize(3,nLayers) !litterSize dimensions: treeOrgans,species + real (kind=8) :: prelesOut(16),fAPARsite + real (kind=8) :: leac=0 !leaching parameter for Yasso + real (kind=8),DIMENSION(nLayers,5) :: fbAWENH,folAWENH,stAWENH + real (kind=8),DIMENSION(nLayers) :: Lb,Lf,Lst +! real (kind=8),DIMENSION(nLayers) :: speciesIDs + + real (kind=8) :: STAND(nVar),STAND_tot(nVar),param(npar)!, output(nYear,nSites,nVar) + integer :: i, ij, ijj ! tree species 1,2,3 = scots pine, norway spruce, birch + + real (kind=8) :: p0_ref, ETS_ref !p0_ref = 1.4, ETS_ref = 1250. + integer :: time, ki, year,yearX=0,Ainit, countThinning,domSp(1) + real (kind=8) :: step, totBA + + real (kind=8) :: stand_all(nVar,nLayers) + real (kind=8) :: outt(nVar,nLayers,2) + real (kind=8) :: modOut((nYears+1),nVar,nLayers,2) + real (kind=8) :: soilC((nYears+1),5,3,nLayers),soilCtot((nYears+1)) + real (kind=8) :: par_phib,par_phic,par_alfat,par_alfar1,par_alfar2,par_alfar3,par_alfar4 + real (kind=8) :: par_alfar5,par_etab,par_k,par_vf,par_vr,par_sla,par_mf,par_mr,par_mw,par_vf0 + real (kind=8) :: par_z,par_rhos,par_cR, par_x, Light,MeanLight(3),par_mf0,par_mr0,par_mw0 + real (kind=8) :: par_sarShp, par_S_branchMod + real (kind=8) :: par_rhof, par_rhor, par_rhow, par_c, par_beta0, par_betab, par_betas + real (kind=8) :: par_s1, par_p0, par_ksi, par_cr2,par_kRein,Rein, c_mort + real (kind=8) :: BA, dA, dB, reineke, dN, wf_test,par_thetaMax, par_Age0, par_gamma + real (kind=8) :: par_rhof0, par_rhof1, par_rhof2, par_aets,dHcCum,dHCum,pars(30) + +!management routines + real (kind=8) :: A_clearcut, D_clearcut, BAr(nLayers), BA_tot,BA_lim, BA_thd, ETSthres = 1000 + +!define varibles + real (kind=8) :: LAT, LONG, sitetype, P0, age, meantemp, mintemp, maxtemp, rainfall, ETS + real (kind=8) :: H, D, B, Hc, Cw, Lc, N, Ntree, Ntot,dNtot + real (kind=8) :: wf_treeKG, wf_STKG, sar_con, sar_ell, rc, ppow, sar,W_stem + real (kind=8) :: lproj, leff,laPer_sar, keff, slc + real (kind=8) :: hb, A, B2,beta0, beta1,beta2, betas, betab + real (kind=8) :: c,dHc,dH,dLc,g0,g1,g2,g3,g4,g5 + real (kind=8) :: npp, p_eff_all + real (kind=8) :: p_eff, par_alfar,p + real (kind=8) :: s0,par_s0scale + real (kind=8) :: weight, dNp,dNb,dNs + real (kind=8) :: W_wsap, respi_m, respi_tot, V_scrown, V_bole, V,Vold + real (kind=8) :: coeff(nLayers), denom,W_froot,W_croot, lit_wf,lit_froot + real (kind=8) :: S_wood,Nold, Nthd, RelSize_thinTree,S_branch,S_fol,S_fr,W_branch + real (kind=8) :: W_stem_old,wf_treeKG_old + +!fix parameters + real (kind=8) :: qcTOT0,Atot,fAPARprel(365) + + !v1 version definitions + real (kind=8) :: theta + +!###initialize model###! +yearX=0 +modOut = 0. +soilC = 0. +countThinning = 1 +pars = pPRELES +soilC(1,:,:,:) = soilCinout(1,:,:,:) +pars(24) = siteInfo(4)!SWinit +pars(25) = siteInfo(5)!CWinit +pars(26) = siteInfo(6) !SOGinit +pars(27) = siteInfo(7) !Sinit + + do i = 1,nLayers + modOut(:,4,i,1) = initVar(1,i) ! assign species + modOut(:,7,i,1) = initVar(2,i) ! assign initAge !age can be made species specific assigning different ages to different species + modOut(1,39,i,1) = sum(soilC(1,:,:,i)) !assign initial soilC + modOut(:,5,i,1) = ETSy ! assign ETS + modOut(:,6,i,1) = P0y ! assign P0 + enddo + modOut(:,1,:,1) = siteInfo(1); modOut(:,2,:,1) = siteInfo(2) !! assign siteID and climID + modOut(1,11,:,1) = initVar(3,:) + modOut(1,12,:,1) = initVar(4,:) + modOut(1,13,:,1) = initVar(5,:) + modOut(1,14,:,1) = initVar(6,:) + modOut(1,17,:,1) = modOut(1,13,:,1)/(pi*((modOut(1,12,:,1)/2/100)**2)) + modOut(1,35,:,1) = modOut(1,13,:,1)/modOut(1,17,:,1) + modOut(:,3,:,1) = siteInfo(3);sitetype = siteInfo(3)! assign site type + soilCtot(1) = sum(soilC(1,:,:,:)) !assign initial soilC + +!######! + +do year = 1, (nYears) + + if(year==yearX)then + totBA = sum(modOut((year-Ainit-1),13,:,1)) + do ijj = 1,nLayers + modOut(year,13,ijj,1) = initClearcut(3) * modOut((year-Ainit-1),13,ijj,1)/ totBA + modOut(year,11,ijj,1) = initClearcut(1) + modOut(year,12,ijj,1) = initClearcut(2) + modOut(year,14,ijj,1) = initClearcut(4) + modOut(year,17,ijj,1) = modOut(year,13,ijj,1)/(pi*((modOut(year,12,ijj,1)/2/100)**2)) + modOut(year,35,ijj,1) = modOut(year,13,ijj,1) / modOut(year,17,ijj,1) + enddo + do ki = 1,Ainit + do ijj = 1,nLayers + modOut((year-Ainit+ki),7,ijj,1) = ki !#!# + modOut((year-Ainit+ki),4,ijj,1) = initVar(1,ijj) !#!# + enddo + enddo + yearX = 0 + endif + + stand_all = modOut(year,:,:,1) + + step = 1. / float(inttimes) + outt(:,:,2) = 0 + + !---------------------------------- + !PHOTOSYNTHESIS MODEL PART 1 + !---------------------------------- + + + + do time = 1, inttimes !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! do ki = 1, nSites + ! calculate self-thinning using all tree classes + Ntot = 1200!sum(STAND_all(17,:)) + B = sum(STAND_all(35,:)*STAND_all(17,:))/Ntot !!!!!!!!!#####changed + if(Ntot>0.) then + Reineke = Ntot*(sqrt(B*4/pi)*100./25.)**(1.66) + else + Reineke = 0. + endif + ! end do + +do ij = 1 , nLayers !loop Species + + STAND=STAND_all(:,ij) + param = pCrobas(:,int(stand_all(4,ij))) + + par_cR=param(1) + par_rhow=param(2) + par_sla =param(3) + par_k =param(4) + par_vf0 =param(5) + par_vr =param(6) + par_c=param(7) + par_mf0=param(8) + par_mr0=param(9) + par_mw0=param(10) + par_z=param(11) + par_beta0=param(12) + par_betab=param(13) + par_betas = param(14) + par_rhof2 = param(15) + par_s1 = param(16) + par_kRein = param(17) + par_s0scale = param(18) + par_x = param(19) + par_aETS = param(20) + par_alfar1 =param(21) + par_alfar2 =param(22) + par_alfar3 =param(23) + par_alfar4 = param(24) + par_alfar5 = param(25) + par_sarShp = param(26) !Shape surface area of the crown: 1.= cone; 2.=ellipsoide + par_S_branchMod = param(27) !model for branch litter model + p0_ref = param(29) + ETS_ref = param(30) + par_thetaMax = param(31) + par_Age0 = param(32) + par_gamma = param(33) + par_rhof1 = 0.!param(20) + par_Cr2 = 0.!param(24) + +! do siteNo = 1, nSites !loop sites + +if (year > maxYearSite) then + STAND(8:21) = 0 !#!# + STAND(23:37) = 0 !#!# + STAND(42:44) = 0 !#!# + +else +! initialize site variables +! sitetype = STAND(3) + + age = STAND(7) + H = STAND(11) + D = STAND(12) + BA = STAND(13) + Hc = STAND(14) + N = BA/(pi*((D/2/100)**2)) + B = BA/N! * par_ops2 +! Cw = STAND(15) + Lc = H - Hc + hb = par_betab * Lc ** par_x + Cw = 2 * hb + STAND(15) = Cw + STAND(16) = LC !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!TO CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!! + ETS = STAND(5) !!##!!2 + Light = STAND(36) + +!!compute V for the first year + +if (N>0) then + + par_rhof0 = par_rhof1 * ETS_ref + par_rhof2 + par_rhof = par_rhof1 * ETS + par_rhof2 + par_vf = par_vf0 / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) +! par_vr = par_vr / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) + + !calculate derived variables + rc = Lc / (H-1.3) !crown ratio + A = rc * B + wf_treeKG = par_rhof * A + par_ksi = wf_treeKG / (Lc ** par_z) + wf_STKG = wf_treeKG * N !needle mass per STAND in units C + ppow=1.6075 + + V_scrown = A * (par_betas*Lc) + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 + V = (V_scrown + V_bole) * N + if(year==1) then + modOut(year,30,ij,1) = V + endif + + !Surface area of the crown + sar_ell= 4 * pi * (((((Lc/2)**ppow)*((Cw/2)**ppow)+((Lc/2)**ppow)*((Cw/2)**ppow)+((Cw/2)**ppow)*((Cw/2)**ppow))/3)**(1/ppow))!surface area per tree + sar_con = pi * ((0.8*hb)**2) * (1 + sqrt(1 + 1 / (((0.8*hb) / Lc)**2))) !surface area per tree + !Ellipsoid for pine and birch, cone for spruce + if(par_sarShp==1.) then + sar = sar_ell + else + sar = sar_con + slc = 0.005 + end if + + !specific leaf area ------------------------------------------------ + laPer_sar = wf_treeKG * par_sla / sar !leaf area per tree / crown surface area + keff = 0.4 * (1 - exp( - par_k / 0.4 * laPer_sar)) / laPer_sar !effective extinction coefficient } + !projected leaf area on the STAND ----------------------------------- + if (wf_STKG>0) then + lproj = par_sla * wf_STKG / 10000. + else + lproj = 0 + end if + !weight per tree STAND$species stratum ------------------------------------ + leff= (keff/par_k)*(wf_STKG*par_sla) / 10000. !effective lai + + STAND(7) = age + STAND(19) = leff + STAND(20) = keff + STAND(21) = lproj + STAND(23) = weight + STAND(24) = W_branch + STAND(25) = W_froot + STAND(11) = H + STAND(12) = D + STAND(13) = BA ! * par_ops2 + STAND(14) = Hc + STAND(15) = Cw + STAND(17) = N + STAND(33) = wf_STKG + STAND(34) = wf_treeKG + STAND(35) = B + STAND(30) = V +else + STAND(8:21) = 0 !#!# + STAND(23:37) = 0 !#!# + STAND(42:44) = 0 !#!# +endif +endif +! end do !!!!!!!end loop sites + + STAND_all(:,ij)=STAND +end do !!!!!!!end loop species + +!!!calculate species weight for photosynthesis +!do siteNo = 1, nSites + +if (year <= maxYearSite) then + call Ffotos2(STAND_all,nLayers,nSp,pCrobas,& + nVar,nPar,MeanLight,coeff,fAPARsite) + STAND_all(36,:) = MeanLight + STAND_all(23,:) = coeff + + if(fAPARsite == 0 .and. yearX == 0) then + if((nYears-year)<10) then + Ainit = nint(6 + 2*3.5 - 0.005*modOut(year,5,1,1) + 2.25) + else + Ainit = nint(6 + 2*3.5 - 0.005*(sum(modOut(year:(year+9),5,1,1))/10) + 2.25) + endif + yearX = Ainit + year +! initClearcut(5) = Ainit + endif + + fAPARprel(:) = fAPARsite + fAPAR(year) = fAPARsite + call preles(weatherPRELES(year,:,:),DOY,fAPARprel,prelesOut, pars, & + dailyPRELES((1+((year-1)*365)):(365*year),1), & !daily GPP + dailyPRELES((1+((year-1)*365)):(365*year),2), & !daily ET + dailyPRELES((1+((year-1)*365)):(365*year),3), & !daily SW + etmodel) !type of ET model + + STAND_all(22,:) = prelesOut(2) !ET + STAND_all(40,:) = prelesOut(15) + STAND_all(41,:) = prelesOut(16) + + pars(24) = prelesOut(3);siteInfo(4) = prelesOut(3)!SWinit + pars(25) = prelesOut(13); siteInfo(5) = prelesOut(13) !CWinit + pars(26) = prelesOut(4); siteInfo(6) = prelesOut(4) !SOGinit + pars(27) = prelesOut(14); siteInfo(7) = prelesOut(14) !Sinit + + STAND_all(10,:) = prelesOut(1)/1000! Photosynthesis in g C m-2 (converted to kg C m-2) + +endif +!enddo !! end site loop + +do ij = 1 , nLayers + STAND=STAND_all(:,ij) + param = pCrobas(:,int(stand_all(4,ij))) + + par_cR=param(1) + par_rhow=param(2) + par_sla =param(3) + par_k =param(4) + par_vf0 =param(5) + par_vr =param(6) + par_c=param(7) + par_mf0=param(8) + par_mr0=param(9) + par_mw0=param(10) + par_z=param(11) + par_beta0=param(12) + par_betab=param(13) + par_betas = param(14) + par_rhof2 = param(15) + par_s1 = param(16) + par_kRein = param(17) + par_s0scale = param(18) + par_x = param(19) + par_aETS = param(20) + par_alfar1 =param(21) + par_alfar2 =param(22) + par_alfar3 =param(23) + par_alfar4 =param(24) + par_alfar5 =param(25) + par_sarShp = param(26) !Shape surface area of the crown: 1.= cone; 2.=ellipsoide + par_S_branchMod = param(27) !model for branch litter model + p0_ref = param(29) + ETS_ref = param(30) + par_thetaMax = param(31) + par_Age0 = param(32) + par_gamma = param(33) + par_rhof1 = 0.!param(20) + par_Cr2 = 0.!param(24) + +! do siteNo = 1, nSites !start site loop + +if (year > maxYearSite) then + STAND(8:21) = 0 !#!# + STAND(23:37) = 0 !#!# + STAND(42:44) = 0 !#!# +else + +! initialize site variables +! sitetype = STAND(3) + age = STAND(7) + p0 = STAND(6)/1000 ! convert g C m-2 to kg C m-2 !#!# + ETS = STAND(5) + H = STAND(11) + D = STAND(12) + BA = STAND(13)! * par_ops2 + Hc = STAND(14) + Cw = STAND(15) + Lc = STAND(16) + N = STAND(17) + Lc = H - Hc + leff = STAND(19) + keff = STAND(20) + lproj = STAND(21) + p_eff_all = STAND(10) !!##!!2 + weight = STAND(23) + + rc = Lc / (H-1.3) !crown ratio + B = BA / N + A = rc * B + + wf_STKG = STAND(33) + wf_treeKG = STAND(34) + B = STAND(35) + Light = STAND(36) + hb = par_betab * Lc ** par_x + Cw = 2 * hb + +if (N>0) then + + +!!!!###here starts stand2 subroutine!!!!!!!!!!!######### + if (sitetype <= 1) then + par_alfar = par_alfar1 + else if (sitetype==2) then + par_alfar = par_alfar2 + else if (sitetype==3) then + par_alfar = par_alfar3 + else if (sitetype==4) then + par_alfar = par_alfar4 + else + par_alfar = par_alfar5 + end if + + !relate metabolic and structural parameters to site conditions + theta = par_thetaMax / (1. + exp(-(age-par_Age0)/par_gamma)) !!!!v1 + + par_mf = par_mf0* p0 / p0_ref + theta !!!!v1 + par_mr = par_mr0* p0 / p0_ref + theta !!!!v1 + par_mw = par_mw0* p0 / p0_ref + theta !!!!v1 + + par_rhof0 = par_rhof1 * ETS_ref + par_rhof2 + par_rhof = par_rhof1 * ETS + par_rhof2 + par_vf = par_vf0 / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) +! par_vr = par_vr / (1. + par_aETS * (ETS-ETS_ref)/ETS_ref) + par_rhor = par_alfar * par_rhof + + ! ------------------------------------- + !GPP all STAND$species UNITS: g C / m2 + ! ------------------------------------- + p_eff = weight * p_eff_all + + if(wf_STKG > 0.) then + s0 = min(par_s0scale * P0 * par_k * par_sla, P_eff / wf_STKG * 10000.) + else + s0 = 0. + endif + + !--------------------------------------- + ! DYNAMIC GROWTH MODEL STARTS + !Updating the tree H, D, Hc and Cw for the next year, according to the method by Valentine & Makela (2005) + !Valentine & Makela 2005. Bridging process - based and empirical approaches to modeling tree growth. + ! HERE the units are kg / ha + + betab = hb/Lc + beta0 = par_beta0 + beta1 = beta0 * (betab + par_betas) + beta2 = beta0 - beta1 + + !Height growth----------------------- + + g0 = par_rhof * par_s1 + par_rhow * par_mw * beta1 + g1 = (1 / (1 + par_z)) * (g0 / (beta1 * par_rhow * (1 + par_c))) + g2 = ((par_rhof * (s0 - par_mf) - (par_rhor * par_mr)) / g0) - & + ((1 + par_c) / g0) * (par_rhof / par_vf + par_rhor / par_vr) + g3 = (par_z / (1 + par_z)) * ((par_rhof + par_rhor) / (par_rhow * beta1)) + g4 = 1 + (par_rhow * par_mw * beta2 - par_rhof * par_s1) / g0 + g5 = (par_z / (1 + par_z)) * (1 / (betab + par_betas)) + dH = g1 * (Lc) * ((g2 - (g4 - 1) * (H-Lc) - H) / (g3 + (g5 - 1) * (H-Lc) + H)) + if(dH < 0.) dH = 0. + !----------------------------------- + !crown rise +! if(H - Hc > par_Cr2*100./sqrt(N)) then +! if(2.*hb > 100./sqrt(N) ) then + dHc = par_cR/Light * dH +if(time==1)then + dHcCum = 0. + dHCum = 0. +endif + dHcCum = dHcCum + dHc + dHCum = dHCum + dH +! else +! dHc = 0 !CAN BE DIFFERENT FROM THE PAPER HARKONEN ET AL. 2013 CANADIAN JOURNAL, SEE THE EQUATION THERE +! endif + if(dHc < 0. )dHc = 0. + + !---------------------------------- + !New values for H, Hc and Lc + + ! diameter growth + + if(Lc > 0.) then + dA = par_z*A*(dH-dHc)/Lc + dB = par_z * (A / Lc) * dH + theta * A !!!! v1 + else + dA = 0. + dB = 0. + endif + +! Mortality - use Reineke from above +! if((Reineke(siteNo) > par_kRein .OR. Light < par_cR) .and. siteThinning(siteNo) == 0) then ! +! if(time==inttimes) then + Rein = Reineke / par_kRein + + if(Rein > 1.) then + dN = - 0.02 * N * Rein + else + dN = 0. + endif + Vold = STAND(30) + Nold = N + if(N < 5.) N = 0.0 + + N = max(0.0, N + step*dN) + +!! Update state variables + + H = H + step * dH + A = A + step * dA + B = B + step * dB + + Hc = Hc + step * dHc + +! Update dependent variables + wf_treeKG = par_rhof * A + wf_STKG = N * wf_treeKG + BA = N * B + D = sqrt(B*4/pi)*100 ! * 100 converts meters in cm + Lc = H - Hc + rc = Lc / (H-1.3) + if(rc > 0.) B2 = A / rc + hb = par_betab * Lc**par_x + hb = betab * Lc + +! Here these were calculated for some reason although they were computed from hb before +! if(species==1) then +! Cw = 2*0.386*Lc**0.8268 +! else if(species==2) then +! Cw = 2*0.4614*Lc**0.5198 +! else +! Cw = 2*0.2689*Lc +! endif + +! more dependent variables (not used in calculation) + W_wsap = N * par_rhow * A * (beta1 * H + beta2 * Hc) + Respi_m = (par_mf + par_alfar*par_mr)* wf_STKG + par_mw * W_wsap +! note changes in the equations below AM 15.5.2015 + npp = (weight * p_eff_all - Respi_m / 10000.) / (1.+par_c) + Respi_tot = weight * p_eff_all - npp + V_scrown = A * (par_betas*Lc) +! note that this equation has changed AM 15.5.2015 + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 +! here the output has been changed to biomass but the name remains V AM 15.5.2015 + W_stem = (V_scrown + V_bole) * N * par_rhow + V = (V_scrown + V_bole) * N +!calculate root baiomasses and litterfall + + W_froot = par_alfar * wf_STKG !fine root biomass + W_croot = W_stem * (beta0 - 1.) !coarse root biomass + W_branch = par_rhow * A * Lc * betab * N +! ! litter fall in the absence of thinning + S_fol = wf_STKG / par_vf !foliage litterfall + S_fr = W_froot / par_vr !fine root litter +! ! branch litter fall pine from Lehtonen et al. 2004 Table 7, with impact of N on litter fall +! ! branch litter for spruce Muukkonen and Lehtonen 2004 Eqn 11 + if(par_S_branchMod .eq. 1.) then + S_branch = W_branch * ((0.0337+0.000009749*N)*exp(-0.00456*D**2)+0.00723) + else + S_branch = W_branch *((-0.00513+0.000012*N)*exp((0.00000732-0.000000764*N)*D**2)+0.00467) + endif + if (dN<0. .and. Nold>0.) then + S_branch = S_branch + W_branch * min(1.,-dN*step/N) + S_wood = (W_croot + W_stem) * min(1.,-dN*step/N) + else + S_wood = 0. + endif + + age = age + step + + STAND(7) = age !#!# + STAND(18) = npp + STAND(8) = Respi_m /10000. + STAND(9) = Respi_tot + STAND(11) = H + STAND(12) = D + STAND(13) = BA + STAND(14) = Hc + STAND(15) = Cw + STAND(16) = Lc + STAND(17) = N + STAND(24) = W_branch + STAND(25) = W_froot + STAND(26) = S_fol + STAND(27) = S_fr + STAND(28) = S_branch + STAND(29) = S_wood + STAND(30) = V + STAND(31) = W_stem + STAND(32) = W_croot + STAND(33) = wf_STKG + STAND(34) = wf_treeKG + STAND(35) = B + STAND(36) = Light + STAND(42) = Vold* min(1.,-dN*step/Nold) + STAND(44) = p_eff +else + STAND(8:21) = 0 !#!# + STAND(23:37) = 0 !#!# + STAND(42:44) = 0 !#!# + STAND(7) = STAND(7) + step +endif +endif + + + !Perform manual thinning or defoliation events for this time period +! If (STAND(13) > 0) then + If (countThinning <= nThinning .and. time==inttimes) Then + If (year == thinning(countThinning,1) .and. ij == thinning(countThinning,3)) Then! .and. siteNo == thinning(countThinning,2)) Then + STAND_tot = STAND + +! STAND(11) = + if(thinning(countThinning,4)==0) then + STAND(8:21) = 0 !#!# + STAND(23:37) = 0 !#!# + STAND(43:44) = 0 !#!# + !! calculate litter including residuals from thinned trees + S_fol = wf_STKG + S_fr = W_froot + S_branch = W_branch + S_wood = S_wood + W_stem* 0.1 + W_croot !0.1 takes into account of the stem residuals after thinnings + STAND(26) = S_fol + STAND(27) = S_fr + STAND(28) = S_branch + STAND(29) = S_wood + else + if(thinning(countThinning,8)==1.) then + if(thinning(countThinning,4) < 2. .and. thinning(countThinning,4) > 0.) then + thinning(countThinning,4) = H * thinning(countThinning,4) + endif + if(thinning(countThinning,5) < 2. .and. thinning(countThinning,5) > 0.) then + thinning(countThinning,5) = D * thinning(countThinning,5) + endif + if(thinning(countThinning,6) < 1. .and. thinning(countThinning,6) > 0.) then + thinning(countThinning,6) = BA * thinning(countThinning,6) + endif + if(thinning(countThinning,7) < 2. .and. thinning(countThinning,7) > 0.) then + thinning(countThinning,7) = Hc * thinning(countThinning,7) + endif + endif + if (thinning(countThinning,4) /= -999) H = thinning(countThinning,4) + if (thinning(countThinning,7) /= -999) Hc = thinning(countThinning,7) + if (thinning(countThinning,5) /= -999) D = thinning(countThinning,5) + BA = thinning(countThinning,6) + Lc = H - Hc !Lc + rc = Lc / (H-1.3) !crown ratio + Nold = N + wf_treeKG_old = wf_treeKG + W_stem_old = W_stem + N = BA/(pi*((D/2/100)**2)) ! N + Nthd = Nold-N ! number of cutted trees + B = BA/N!(pi*((D/2/100)**2)) + A = rc * B + wf_treeKG = par_rhof * A + + V_scrown = A * (par_betas*Lc) + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 + W_stem = (V_scrown + V_bole) * N * par_rhow + RelSize_thinTree = (W_stem/N)/(W_stem_old/Nold) + V = (V_scrown + V_bole) * N + wf_STKG = N * wf_treeKG + hb = par_betab * Lc ** par_x + Cw = 2 * hb +!! calculate litter including residuals from thinned trees + S_fol = S_fol + wf_treeKG_old * Nthd + S_fr = S_fr + W_froot * Nthd/Nold + S_branch = S_branch + W_branch * Nthd/Nold + S_wood = S_wood + (W_stem_old*0.1 + W_croot) * Nthd/Nold +!!update biomasses + W_froot = par_alfar * wf_STKG !fine root biomass + W_croot = W_stem * (beta0 - 1.) !coarse root biomass + W_branch = par_rhow * A * Lc * betab * N + + outt(11,ij,2) = STAND_tot(11) + outt(12,ij,2) = STAND_tot(12) + outt(13,ij,2) = STAND_tot(13) - BA + outt(14,ij,2) = STAND_tot(14) + outt(15,ij,2) = STAND_tot(15) + outt(16,ij,2) = STAND_tot(16) + outt(17,ij,2) = Nthd + outt(18:23,ij,2) = -999 + outt(24,ij,2) = STAND_tot(24) - W_branch + outt(25,ij,2) = STAND_tot(25) - W_froot + outt(26:29,ij,2) = -999 + outt(30,ij,2) = STAND_tot(30) - V + outt(31,ij,2) = STAND_tot(31) - W_stem + outt(32,ij,2) = Nthd * W_croot/N + outt(33,ij,2) = STAND_tot(33) - wf_STKG + outt(34,ij,2) = (STAND_tot(34)*Nold - wf_treeKG*N)/Nthd + outt(35,ij,2) = -999; outt(36,ij,2)= -999 + + STAND(11) = H + STAND(12) = D + STAND(13) = BA + STAND(14) = Hc ! stand Hc + STAND(15) = Cw + STAND(16) = Lc ! stand Lc + STAND(17) = N + STAND(26) = S_fol + STAND(27) = S_fr + STAND(28) = S_branch + STAND(29) = S_wood + STAND(30) = V ! + STAND(31) = W_stem + STAND(32) = W_croot + STAND(33) = wf_STKG + STAND(34) = wf_treeKG + STAND(35) = B + endif + + countThinning = countThinning + 1 + + End If + End If + + STAND_all(:,ij)=STAND +end do !!!!end loop species + end do !!!!end loop inttimes + + +!Perform thinning or defoliation events for this time period using standard management routines!!!!!!!!!!!!!!!! +!do siteNo = 1, nSites + +!!!!test for clearcut!!!! + domSp = maxloc(STAND_all(13,:)) + +if (ClCut == 1.) then + D_clearcut = inDclct(int(stand_all(4,domSp(1)))) + A_clearcut = inAclct(int(stand_all(4,domSp(1)))) + D = stand_all(12,domSp(1)) + age = stand_all(7,domSp(1)) + + if ((D > D_clearcut) .or. (age > A_clearcut)) then + do ij = 1, nLayers + outt(6:nVar,ij,2) = stand_all(6:nVar,ij) + S_fol = stand_all(33,ij) + stand_all(26,ij) + S_fr = stand_all(25,ij) + stand_all(27,ij) + S_branch = stand_all(24,ij) + stand_all(28,ij) + S_wood = stand_all(31,ij)* 0.1 + stand_all(32,ij) + stand_all(29,ij) !0.1 takes into account of the stem residuals after clearcuts + stand_all(8:21,ij) = 0. + stand_all(23:37,ij) = 0 !#!# + stand_all(43:44,ij) = 0 + stand_all(26,ij) = S_fol + stand_all(27,ij) = S_fr + stand_all(28,ij) = S_branch + stand_all(29,ij) = S_wood + enddo + endif +endif + +!!!!test for thinnings!!!! + !!!!!!!for coniferous dominated stands!!!!!! +if(defaultThin == 1.) then +! sitetype = siteInfo(3) + BA_tot = sum(stand_all(13,:))!+stand_all(13,2)+stand_all(13,3) + BAr = stand_all(13,:)/BA_tot +! BAr_SP = stand_all(13,2)/BA_tot +! BAr_B = stand_all(13,3)/BA_tot + BA_lim = 9999999999.9 + BA_thd = 0. + domSp = maxloc(STAND_all(13,:)) + H = stand_all(11,domSp(1)) + if(H>12.) then + if(pCrobas(28,int(stand_all(4,int(domSp(1)))))==1.) then + if(sitetype < 3) then + if(H<20.) then + BA_lim = -0.0893*H**2. + 4.0071*H - 11.343 + BA_thd = -0.0536*H**2. + 2.7643*H - 9.6857 + else + BA_lim = 33. + BA_thd = 24. + endif + endif + if(sitetype == 3) then + if(H<20.) then + BA_lim = -0.125*H**2. + 4.95*H - 20.9 + BA_thd = -0.1071*H**2. + 3.9286*H - 15.771 + else + BA_lim = 28. + BA_thd = 20. + endif + endif + if(sitetype == 4) then + if(H<20.) then + BA_lim = -0.1071*H**2. + 4.2286*H - 15.571 + BA_thd = -0.0714*H**2. + 2.7857*H - 9.1143 + else + BA_lim = 26. + BA_thd = 18. + endif + endif + if(sitetype == 5) then + if(H<20.) then + BA_lim = -0.0714*H**2. + 2.9857*H - 7.9143 + BA_thd = -0.0714*H**2. + 2.7857*H - 11.114 + else + BA_lim = 23. + BA_thd = 16. + endif + endif +!!!!!!!for decidous dominated stands!!!!!! + elseif(pCrobas(28,int(stand_all(4,int(domSp(1)))))==2.) then + if(H<20.) then + BA_lim = -0.0179*H**2. + 1.2214*H + 3.7714 + BA_thd = -0.0536*H**2. + 2.4643*H - 12.886 + else + BA_lim = 21. + BA_thd = 15. + endif + endif + endif + if (BA_tot > BA_lim) then + do ij = 1, nLayers +!ij=1 + if(stand_all(17,ij)>0.) then + STAND_tot = stand_all(:,ij) + param = pCrobas(:,int(stand_all(4,ij))) + par_cR=param(1) + par_rhow=param(2) + par_sla =param(3) + par_k =param(4) + par_vf0 =param(5) + par_vr =param(6) + par_c=param(7) + par_mf0=param(8) + par_mr0=param(9) + par_mw0=param(10) + par_z=param(11) + par_beta0=param(12) + par_betab=param(13) + par_betas = param(14) + par_rhof2 = param(15) + par_s1 = param(16) + par_kRein = param(17) + par_s0scale = param(18) + par_x = param(19) + par_aETS = param(20) + par_alfar1 =param(21) + par_alfar2 =param(22) + par_alfar3 =param(23) + par_alfar4 =param(24) + par_alfar5 =param(25) + par_sarShp = param(26) !Shape surface area of the crown: 1.= cone; 2.=ellipsoide + par_S_branchMod = param(27) !model for branch litter model + p0_ref = param(29) + ETS_ref = param(30) + par_thetaMax = param(31) + par_Age0 = param(32) + par_gamma = param(33) + par_rhof1 = 0.!param(20) + par_Cr2 = 0.!param(24) + par_rhof = par_rhof1 * stand_all(5,ij) + par_rhof2 + BA_tot = BA_thd + BA = BAr(ij) * BA_thd + if(par_sarShp==1.) then + H = stand_all(11,ij) * (1.2147-0.2086 * (BA/ stand_all(13,ij))) + D = stand_all(12,ij) * (1.2192 -0.2173 * (BA/ stand_all(13,ij))) + else + H = stand_all(11,ij) * (1.07386 -0.06553 * (BA/ stand_all(13,ij))) + D = stand_all(12,ij) * (1.1779 -0.1379 * (BA/ stand_all(13,ij))) + endif + stand_all(13,ij) = BA + Nold = stand_all(17,ij) + N = BA/(pi*((D/2/100)**2)) + Nthd = Nold - N + Hc = stand_all(14,ij) + Lc = H - Hc !Lc + rc = Lc / (H-1.3) !crown ratio + wf_treeKG_old = stand_all(34,ij) + W_stem_old = stand_all(31,ij) + B = BA/N + A = rc * B + wf_treeKG = par_rhof * A + V_scrown = A * (par_betas*Lc) + V_bole = (A+B+sqrt(A*B)) * Hc /2.9 + W_stem = (V_scrown + V_bole) * N * par_rhow + V = (V_scrown + V_bole) * N + outt(30,ij,2) = outt(30,ij,2) - V + wf_STKG = N * wf_treeKG + hb = par_betab * Lc ** par_x + betab = hb/Lc + + Cw = 2 * hb +!! calculate litter including residuals from thinned trees + S_fol = stand_all(26,ij) + wf_treeKG_old * Nthd + S_fr = stand_all(27,ij) + stand_all(25,ij) * Nthd/Nold + S_branch = stand_all(28,ij) + stand_all(24,ij) * Nthd/Nold + S_wood = stand_all(29,ij) + (W_stem_old*0.1 + stand_all(32,ij)) * Nthd/Nold +!!update biomasses + if (sitetype <= 1) then + par_alfar = par_alfar1 + else if (sitetype==2) then + par_alfar = par_alfar2 + else if (sitetype==3) then + par_alfar = par_alfar3 + else if (sitetype==4) then + par_alfar = par_alfar4 + else + par_alfar = par_alfar5 + end if + + W_froot = par_alfar * wf_STKG !fine root biomass + W_croot = W_stem * (par_beta0 - 1.) !coarse root biomass + W_branch = par_rhow * A * Lc * betab * N + + outt(11,ij,2)= STAND_tot(11) + outt(12,ij,2)= STAND_tot(12) + outt(13,ij,2)= STAND_tot(13) - BA + outt(14,ij,2)= STAND_tot(14) + outt(15,ij,2)= STAND_tot(15) + outt(16,ij,2)= STAND_tot(16) + outt(17,ij,2)= Nthd + outt(18:23,ij,2)= -999 + outt(24,ij,2)= STAND_tot(24) - W_branch + outt(25,ij,2)= STAND_tot(25) - W_froot + outt(26:29,ij,2)= -999 + outt(30,ij,2)= STAND_tot(30) - V + outt(31,ij,2)= STAND_tot(31) - W_stem + outt(32,ij,2)= Nthd * W_croot/N + outt(33,ij,2)= STAND_tot(33) - wf_STKG + outt(34,ij,2)= (STAND_tot(34)*Nold - wf_treeKG*N)/Nthd + outt(35,ij,2)= -999; outt(36,ij,2)= -999 + + stand_all(11,ij) = H + stand_all(12,ij) = D + stand_all(13,ij) = BA + stand_all(17,ij) = N + stand_all(26,ij) = S_fol + stand_all(27,ij) = S_fr + stand_all(28,ij) = S_branch + stand_all(29,ij) = S_wood + stand_all(24,ij) = W_branch + stand_all(25,ij) = W_froot + stand_all(30,ij) = V ! + stand_all(31,ij) = W_stem + stand_all(32,ij) = W_croot + stand_all(33,ij) = wf_STKG + stand_all(34,ij) = wf_treeKG + stand_all(35,ij) = B + endif + enddo + endif +endif !default thin + +outt(:,:,1)=STAND_all + +modOut((year+1),7:nVar,:,:) = outt(7:nVar,:,:) + +!!!!run Yasso + if(yassoRun==1.) then + do ijj = 1, nLayers + Lst(ijj) = outt(29,ijj,1) + Lb(ijj) = outt(28,ijj,1) + Lf(ijj) = outt(26,ijj,1)+outt(27,ijj,1) + + call compAWENH(Lf(ijj),folAWENH(ijj,:),pAWEN(1:4,int(outt(4,ijj,1)))) !!!awen partitioning foliage + call compAWENH(Lb(ijj),fbAWENH(ijj,:),pAWEN(5:8,int(outt(4,ijj,1)))) !!!awen partitioning branches + call compAWENH(Lst(ijj),stAWENH(ijj,:),pAWEN(9:12,int(outt(4,ijj,1)))) !!!awen partitioning stems + + call mod5c(pYasso,t,weatherYasso(year,:),soilC((year),:,1,ijj),stAWENH(ijj,:),litterSize(1,ijj), & + leac,soilC((year+1),:,1,ijj),steadystate_pred) + call mod5c(pYasso,t,weatherYasso(year,:),soilC((year),:,2,ijj),fbAWENH(ijj,:),litterSize(2,ijj), & + leac,soilC((year+1),:,2,ijj),steadystate_pred) + call mod5c(pYasso,t,weatherYasso(year,:),soilC((year),:,3,ijj),folAWENH(ijj,:),litterSize(3,ijj), & + leac,soilC((year+1),:,3,ijj),steadystate_pred) + enddo + + soilCtot(year+1) = sum(soilC(year+1,:,:,:)) + endif !end yassoRun if +enddo !end year loop + +!soil and harvested volume outputs +modOut(:,37,:,1) = modOut(:,30,:,2) + +do year = 1,(nYears+1) + do ijj = 1, nLayers + modOut(year,38,ijj,1) = sum(modOut(1:year,30,ijj,2)) + & + sum(modOut(1:year,42,ijj,1)) + modOut(year,30,ijj,1) + modOut(year,39,ijj,1) = sum(soilC(year,:,:,ijj)) + enddo +enddo + +!compute gross growth + modOut(2:(nYears+1),43,:,1) = modOut(2:(nYears+1),38,:,1) - modOut(1:(nYears),38,:,1) + +!compute fluxes in g C m−2 day−1 + modOut(:,44,:,1) = modOut(:,44,:,1)*1000 !*1000 coverts units to g C m−2 y−1 + modOut(:,9,:,1) = modOut(:,9,:,1)*1000 !*1000 coverts units to g C m−2 y−1 + modOut(:,18,:,1) = modOut(:,18,:,1)*1000 !*1000 coverts units to g C m−2 y−1 + + modOut(2:(nYears+1),45,:,1) = modOut(1:(nYears),39,:,1)/10 - modOut(2:(nYears+1),39,:,1)/10 + & !/10 coverts units to g C m−2 y−1 + modOut(2:(nYears+1),26,:,1)/10 + modOut(2:(nYears+1),27,:,1)/10 + & + modOut(2:(nYears+1),28,:,1)/10 + modOut(2:(nYears+1),29,:,1)/10 + + modOut(:,46,:,1) = modOut(:,44,:,1) - modOut(:,9,:,1) - modOut(:,45,:,1) + + output = modOut(2:(nYears+1),:,:,:) + output(:,5:6,:,:) = modOut(1:(nYears),5:6,:,:) + soilCinOut = soilC(2:(nYears+1),:,:,:) + soilCtotInOut = soilCtot(2:(nYears+1)) + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/src/C_multiPrebas.f90 b/src/C_multiPrebas.f90 new file mode 100644 index 0000000..3adbe8a --- /dev/null +++ b/src/C_multiPrebas.f90 @@ -0,0 +1,68 @@ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!subroutine bridging +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine multiPrebas(multiOut,nSites,nClimID,nLayers,maxYears,maxThin, & + nYears,thinning,pCrobas,allSP,siteInfo, maxNlayers, & + nThinning,fAPAR,initClearcut, fixBAinitClearcut,initCLcutRatio,ETSy,P0y, initVar,& + weatherPRELES,DOY,pPRELES,etmodel, soilCinOut,pYasso,& + pAWEN,weatherYasso,litterSize,soilCtotInOut, & + defaultThin,ClCut,inDclct,inAclct,dailyPRELES,yassoRun,prebasVersion) + +implicit none + +integer, parameter :: nVar=46,npar=37! +integer, intent(in) :: nYears(nSites),nLayers(nSites),allSP +integer :: i,climID +integer, intent(in) :: nSites, maxYears, maxThin,nClimID,maxNlayers +real (kind=8), intent(in) :: weatherPRELES(nClimID,maxYears,365,5) + integer, intent(in) :: DOY(365),etmodel + real (kind=8), intent(in) :: pPRELES(30),pCrobas(npar,allSP) + real (kind=8), intent(inout) :: siteInfo(nSites,7),fixBAinitClearcut(nSites),initCLcutRatio(nSites,maxNlayers) + real (kind=8), intent(in) :: thinning(nSites,maxThin,8),pAWEN(12,allSP) + real (kind=8), intent(inout) :: dailyPRELES(nSites,(maxYears*365),3) + real (kind=8), intent(inout) :: initClearcut(nSites,5) !initial stand conditions after clear cut. (H,D,totBA,Hc,Ainit) +! real (kind=8), intent(in) :: pSp1(npar),pSp2(npar),pSp3(npar)!,par_common + real (kind=8), intent(in) :: defaultThin(nSites),ClCut(nSites),yassoRun(nSites),prebasVersion(nSites) + real (kind=8), intent(in) :: inDclct(nSites,allSP),inAclct(nSites,allSP) +! integer, intent(in) :: siteThinning(nSites) + integer, intent(inout) :: nThinning(nSites) + real (kind=8), intent(out) :: fAPAR(nSites,maxYears) + real (kind=8), intent(in) :: initVar(nSites,6,maxNlayers),P0y(nClimID,maxYears),ETSy(nClimID,maxYears)!,par_common + real (kind=8), intent(inout) :: multiOut(nSites,maxYears,nVar,maxNlayers,2) + real (kind=8), intent(inout) :: soilCinOut(nSites,maxYears,5,3,maxNlayers),soilCtotInOut(nSites,maxYears) !dimensions = nyears,AWENH,treeOrgans(woody,fineWoody,Foliage),species + real (kind=8), intent(in) :: pYasso(35), weatherYasso(nClimID,maxYears,3),litterSize(3,allSP) !litterSize dimensions: treeOrgans,species + real (kind=8) :: output(maxYears,nVar,maxNlayers,2) + integer :: maxYearSite = 100000000 + + multiOut = 0. + do i = 1,nSites + ! write(*,*) i + climID = siteInfo(i,2) + if(prebasVersion(i)==0.) then + call prebas_v0(nYears(i),nLayers(i),allSP,siteInfo(i,:),pCrobas,initVar(i,:,1:nLayers(i)),& + thinning(i,1:nThinning(i),:),output(1:nYears(i),:,1:nLayers(i),:),nThinning(i),maxYearSite,& + fAPAR(i,1:nYears(i)),initClearcut(i,:),& + fixBAinitClearcut(i),initCLcutRatio(i,1:nLayers(i)),ETSy(climID,1:nYears(i)),P0y(climID,1:nYears(i)),& + weatherPRELES(climID,1:nYears(i),:,:),DOY,pPRELES,etmodel, & + soilCinOut(i,1:nYears(i),:,:,1:nLayers(i)),pYasso,pAWEN,weatherYasso(climID,1:nYears(i),:),& + litterSize,soilCtotInOut(i,1:nYears(i)),& + defaultThin(i),ClCut(i),inDclct(i,:),inAclct(i,:),dailyPRELES(i,1:(nYears(i)*365),:),yassoRun(i)) + elseif(prebasVersion(i)==1.) then + call prebas_v1(nYears(i),nLayers(i),allSP,siteInfo(i,:),pCrobas,initVar(i,:,1:nLayers(i)),& + thinning(i,1:nThinning(i),:),output(1:nYears(i),:,1:nLayers(i),:),nThinning(i),maxYearSite,& + fAPAR(i,1:nYears(i)),initClearcut(i,:),& + fixBAinitClearcut(i),initCLcutRatio(i,1:nLayers(i)),ETSy(climID,1:nYears(i)),P0y(climID,1:nYears(i)),& + weatherPRELES(climID,1:nYears(i),:,:),DOY,pPRELES,etmodel, & + soilCinOut(i,1:nYears(i),:,:,1:nLayers(i)),pYasso,pAWEN,weatherYasso(climID,1:nYears(i),:),& + litterSize,soilCtotInOut(i,1:nYears(i)),& + defaultThin(i),ClCut(i),inDclct(i,:),inAclct(i,:),dailyPRELES(i,1:(nYears(i)*365),:),yassoRun(i)) + endif + multiOut(i,:,:,1:nLayers(i),:) = output(:,:,1:nLayers(i),:) +end do + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + diff --git a/src/C_regionPrebas.f90 b/src/C_regionPrebas.f90 new file mode 100644 index 0000000..862b611 --- /dev/null +++ b/src/C_regionPrebas.f90 @@ -0,0 +1,252 @@ + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!subroutine bridging +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +subroutine regionPrebas(siteOrder,HarvLim,minDharv,multiOut,nSites,nClimID,nLayers,maxYears,maxThin, & + nYears,thinning,pCrobas,allSP,siteInfo, maxNlayers, & + nThinning,fAPAR,initClearcut,fixBAinitClarcut,initCLcutRatio,ETSy,P0y, initVar,& + weatherPRELES,DOY,pPRELES,etmodel, soilCinOut,pYasso,& + pAWEN,weatherYasso,litterSize,soilCtotInOut, & + defaultThin,ClCut,inDclct,inAclct,dailyPRELES,yassoRun,prebasVersion) + +implicit none + +integer, parameter :: nVar=46,npar=37!, nSp=3 +integer, intent(in) :: nYears(nSites),nLayers(nSites),allSP +integer :: i,climID,ij,iz,ijj,ki,n,jj,az +integer, intent(in) :: nSites, maxYears, maxThin,nClimID,maxNlayers,siteOrder(nSites,maxYears) +real (kind=8), intent(in) :: weatherPRELES(nClimID,maxYears,365,5),HarvLim(maxYears),minDharv + integer, intent(in) :: DOY(365),etmodel + real (kind=8), intent(in) :: pPRELES(30),pCrobas(npar,allSP) + real (kind=8), intent(inout) :: siteInfo(nSites,7) + real (kind=8), intent(in) :: thinning(nSites,maxThin,8),pAWEN(12,allSP) + real (kind=8), intent(inout) :: dailyPRELES(nSites,(maxYears*365),3) + real (kind=8), intent(inout) :: initClearcut(nSites,5),fixBAinitClarcut(nSites),initCLcutRatio(nSites,maxNlayers) !initial stand conditions after clear cut. (H,D,totBA,Hc,Ainit) +! real (kind=8), intent(in) :: pSp1(npar),pSp2(npar),pSp3(npar)!,par_common + real (kind=8), intent(in) :: defaultThin(nSites),ClCut(nSites),yassoRun(nSites),prebasVersion(nSites) + real (kind=8), intent(in) :: inDclct(nSites,allSP),inAclct(nSites,allSP) +! integer, intent(in) :: siteThinning(nSites) + integer, intent(inout) :: nThinning(nSites) + real (kind=8), intent(out) :: fAPAR(nSites,maxYears) + real (kind=8), intent(inout) :: initVar(nSites,6,maxNlayers),P0y(nClimID,maxYears),ETSy(nClimID,maxYears)!,par_common + real (kind=8), intent(inout) :: multiOut(nSites,maxYears,nVar,maxNlayers,2) + real (kind=8), intent(inout) :: soilCinOut(nSites,maxYears,5,3,maxNlayers),soilCtotInOut(nSites,maxYears) !dimensions = nyears,AWENH,treeOrgans(woody,fineWoody,Foliage),species + real (kind=8) :: soilC(nSites,maxYears,5,3,maxNlayers),soilCtot(nSites,maxYears) !dimensions = nyears,AWENH,treeOrgans(woody,fineWoody,Foliage),species + real (kind=8), intent(in) :: pYasso(35), weatherYasso(nClimID,maxYears,3),litterSize(3,allSP) !litterSize dimensions: treeOrgans,species + real (kind=8) :: output(1,nVar,maxNlayers,2),totBA(nSites), relBA(nSites,maxNlayers) + real (kind=8) :: ClCutX, HarvArea,defaultThinX,maxState(nSites),check(maxYears), thinningX(maxThin,8) + integer :: maxYearSite = 300,yearX(nSites),Ainit,sitex,ops(1) + +!!!!initialize run +multiOut = 0. +yearX = 0. +soilC = soilCinOut +soilCtot = soilCtotInOut + +do i = 1,nSites + relBA(i,1:nLayers(i)) = initVar(i,5,1:nLayers(i))/sum(initVar(i,5,1:nLayers(i))) +enddo + +do ij = 1,maxYears + HarvArea = 0. + do iz = 1,nSites + i=siteOrder(iz,ij) +! open(10,file="multiSite.txt") + ! write(10,*) "years =",ij, "siteRun = ",iz +! close(10) + ClCutX = ClCut(i) + defaultThinX = defaultThin(i) + thinningX(:,:) = -999. + az = 0 + + if(ij > 1) then + soilC(i,ij,:,:,1:nLayers(i)) = soilC(i,(ij-1),:,:,1:nLayers(i)) + endif + +!!!check if the limit has been exceeded if yes no havest (thinning or clearcut will be performed) + if (HarvLim(ij) > 0. .and. HarvArea >= HarvLim(ij)) then + ClCutX = 0. + defaultThinX = 0. + endif +!!! + climID = siteInfo(i,2) + if(ij==int(min(yearX(i),maxYears)))then + initClearcut(i,5) = int(min(initClearcut(i,5), initClearcut(i,5) + maxYears - yearX(i))) + yearX(i) = 0 + + do ijj = 1,nLayers(i) + initVar(i,1,ijj) = multiOut(i,1,4,ijj,1) + initVar(i,2,ijj) = initClearcut(i,5) + initVar(i,3,ijj) = initClearcut(i,1) + initVar(i,4,ijj) = initClearcut(i,2) + if(fixBAinitClarcut(i)==1) then + initVar(i,5,ijj) = initClearcut(i,3) * initCLcutRatio(i,ijj) + else + initVar(i,5,ijj) = initClearcut(i,3) * relBA(i,ijj) + endif + initVar(i,6,ijj) = initClearcut(i,4) + do ki = 1,int(initClearcut(i,5)+1) + multiOut(i,int(ij-initClearcut(i,5)+ki-1),7,ijj,1) = ki !#!# + enddo !ki + enddo !ijj + endif + + do jj = 1, nThinning(i) + if(thinning(i,jj,1) == ij) then + az = az + 1 + thinningX(az,:) = thinning(i,jj,:) + thinningX(az,1) = 1. + endif + enddo + ! if(ij==1) then + ! write(*,*) sum(soilCinOut(i,ij,:,:,1:nLayers(i))) + ! endif + + + if(prebasVersion(i)==0.) then + call prebas_v0(1,nLayers(i),allSP,siteInfo(i,:),pCrobas,initVar(i,:,1:nLayers(i)),& + thinningX(1:az,:),output(1,:,1:nLayers(i),:),az,maxYearSite,fAPAR(i,ij),initClearcut(i,:),& + fixBAinitClarcut(i),initCLcutRatio(i,1:nLayers(i)),ETSy(climID,ij),P0y(climID,ij),& + weatherPRELES(climID,ij,:,:),DOY,pPRELES,etmodel, & + soilC(i,ij,:,:,1:nLayers(i)),pYasso,pAWEN,weatherYasso(climID,ij,:),& + litterSize,soilCtot(i,ij),& + defaultThinX,ClCutX,inDclct(i,:),inAclct(i,:),dailyPRELES(i,(((ij-1)*365)+1):(ij*365),:),yassoRun(i)) + elseif(prebasVersion(i)==1.) then + call prebas_v1(1,nLayers(i),allSP,siteInfo(i,:),pCrobas,initVar(i,:,1:nLayers(i)),& + thinningX(1:az,:),output(1,:,1:nLayers(i),:),az,maxYearSite,fAPAR(i,ij),initClearcut(i,:),& + fixBAinitClarcut(i),initCLcutRatio(i,1:nLayers(i)),ETSy(climID,ij),P0y(climID,ij),& + weatherPRELES(climID,ij,:,:),DOY,pPRELES,etmodel, & + soilC(i,ij,:,:,1:nLayers(i)),pYasso,pAWEN,weatherYasso(climID,ij,:),& + litterSize,soilCtot(i,ij),& + defaultThinX,ClCutX,inDclct(i,:),inAclct(i,:),dailyPRELES(i,(((ij-1)*365)+1):(ij*365),:),yassoRun(i)) + endif + + ! if clearcut occur initialize initVar and age + if(sum(output(1,11,1:nLayers(i),1))==0 .and. yearX(i) == 0) then + if((maxYears-ij)<15) then + Ainit = nint(6 + 2*3.5 - 0.005*ETSy(climID,ij) + 2.25) + else + Ainit = nint(6 + 2*3.5 - 0.005*(sum(ETSy(climID,(ij+1):(ij+10)))/10) + 2.25) + endif + yearX(i) = Ainit + ij + 1 + initClearcut(i,5) = Ainit + if(ij==1) then + relBA(i,1:nLayers(i)) = initVar(i,5,1:nLayers(i))/sum(initVar(i,5,1:nLayers(i))) + endif + endif + + ! write(10,*) "here1" + !!!calculate deadWood using Gompetz function (Makinen et al. 2006)!!!! + do ijj = 1,nLayers(i) + if(output(1,8,ijj,1)>0.) then + multiOut(i,ij,8,ijj,1) = multiOut(i,ij,8,ijj,1) + output(1,8,ijj,1) + jj = int(output(1,4,ijj,1)) + do ki = 1,(maxYears-ij) + multiOut(i,(ki+ij),8,ijj,1) = multiOut(i,(ki+ij),8,ijj,1) + output(1,8,ijj,1) * & + exp(-exp(pCrobas(34,jj) + pCrobas(35,jj)*ijj + pCrobas(36,jj)*output(1,12,ijj,1) + 0.)) + enddo + end if + enddo + + multiOut(i,ij,1:7,1:nLayers(i),:) = output(1,1:7,1:nLayers(i),:) + multiOut(i,ij,9:nVar,1:nLayers(i),:) = output(1,9:nVar,1:nLayers(i),:) + ! do ijj = 1,nLayers(i) + ! multiOut(i,ij,38,ijj,1) = sum(multiOut(i,1:ij,30,ijj,2)) + & + ! sum(multiOut(i,1:ij,42,ijj,1)) + multiOut(i,ij,30,ijj,1) + + ! if(ij > 1.5) then + ! !compute gross growth + ! multiOut(i,ij,43,ijj,1) = multiOut(i,ij,38,ijj,1) - multiOut(i,(ij-1),38,ijj,1) + ! endif + + ! enddo !ijj +! write(10,*) "here2" + + initVar(i,1,1:nLayers(i)) = output(1,4,1:nLayers(i),1) + initVar(i,2,1:nLayers(i)) = output(1,7,1:nLayers(i),1) + initVar(i,3:6,1:nLayers(i)) = output(1,11:14,1:nLayers(i),1) + HarvArea = HarvArea + sum(output(1,37,1:nLayers(i),1)) + end do !iz i + + +! write(10,*) "here3" + + + !!! check if the harvest limit of the area has been reached otherwise clearcut the stands sorted by basal area + if (HarvArea < HarvLim(ij)) then + n = 0 + do while(n < nSites .and. HarvArea < HarvLim(ij)) + n = n + 1 + do i = 1, nSites + maxState(i) = maxval(multiOut(i,ij,12,1:nLayers(i),1))!!!search for site with highest DBH + enddo ! i + ops = maxloc(maxState) + siteX = int(ops(1)) + climID = int(siteInfo(siteX,2)) +if(maxState(siteX)>minDharv .and. ClCut(siteX) > 0.) then + ! close(10) +!! !!clearcut!! + HarvArea = HarvArea + sum(multiOut(siteX,ij,30,1:nLayers(siteX),1)) + multiOut(siteX,ij,37,:,1) = multiOut(siteX,ij,37,1:nLayers(siteX),1) + multiOut(siteX,ij,30,1:nLayers(siteX),1) + do ijj = 1, nLayers(siteX) + multiOut(siteX,ij,6:nVar,ijj,2) = multiOut(siteX,ij,6:nVar,ijj,1) + multiOut(siteX,ij,26,ijj,1) = multiOut(siteX,ij,33,ijj,1) + multiOut(siteX,ij,26,ijj,1) + multiOut(siteX,ij,27,ijj,1) = multiOut(siteX,ij,25,ijj,1) + multiOut(siteX,ij,27,ijj,1) + multiOut(siteX,ij,28,ijj,1) = multiOut(siteX,ij,24,ijj,1) + multiOut(siteX,ij,28,ijj,1) + multiOut(siteX,ij,29,ijj,1) = multiOut(siteX,ij,31,ijj,1)* 0.1 + & + multiOut(siteX,ij,32,ijj,1) + multiOut(siteX,ij,29,ijj,1) !0.1 takes into account of the stem residuals after clearcuts + multiOut(siteX,ij,8:21,ijj,1) = 0. + multiOut(siteX,ij,23:36,ijj,1) = 0. !#!# + multiOut(siteX,ij,43:44,ijj,1) = 0. + multiOut(siteX,ij,38,ijj,1) = sum(multiOut(siteX,1:ij,30,ijj,2)) + & + sum(multiOut(siteX,1:ij,42,ijj,1)) + multiOut(siteX,ij,30,ijj,1) + enddo + if((maxYears-ij)<10) then + Ainit = nint(6 + 2*3.5 - 0.005*ETSy(climID,ij) + 2.25) + else + Ainit = nint(6 + 2*3.5 - 0.005*(sum(ETSy(climID,(ij+1):(ij+10)))/10) + 2.25) + endif + yearX(siteX) = Ainit + ij + 1 + initClearcut(siteX,5) = Ainit + if(ij==1) then + relBA(siteX,1:nLayers(siteX)) = initVar(siteX,5,1:nLayers(siteX))/ & + sum(initVar(siteX,5,1:nLayers(siteX))) + else + relBA(siteX,1:nLayers(siteX)) = multiOut(siteX,(ij-1),13,1:nLayers(siteX),1)/ & + sum(multiOut(siteX,(ij-1),13,1:nLayers(siteX),1)) + endif + + !initVar(siteX,1,1:nLayers(siteX)) = 0. !output(1,4,:,1) + initVar(siteX,2,1:nLayers(siteX)) = 0.!output(1,7,:,1) + initVar(siteX,3:6,1:nLayers(siteX)) = 0.!output(1,11:14,:,1) +endif !(maxState(i)>minDharv) + enddo !end do while + endif !HarvArea < HarvLim .and. HarvLim /= 0. +! write(10,*) "here4" +end do +do i = 1,nSites + do ij = 1, maxYears + do ijj = 1,nLayers(i) + ! multiOut(i,ij,38,ijj,1) = sum(multiOut(i,1:ij,30,ijj,2)) + & + ! sum(multiOut(i,1:ij,42,ijj,1)) + multiOut(i,ij,30,ijj,1) + + if(ij > 1.5) then + !compute gross growth + multiOut(i,ij,43,ijj,1) = multiOut(i,ij,30,ijj,1) - multiOut(i,(ij-1),30,ijj,1) + & + multiOut(i,ij,37,ijj,1) + multiOut(i,ij,42,ijj,1) + endif + + enddo !ijj + enddo +enddo +! close(10) +! write(10,*) "here5" +! close(10) +soilCinOut = soilC +soilCtotInOut = soilCtot + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + diff --git a/src/call_preles.c b/src/call_preles.c new file mode 100644 index 0000000..b88a34e --- /dev/null +++ b/src/call_preles.c @@ -0,0 +1,208 @@ +#include "prelesglobals.h" +/* 26.4.2013 Mikko Peltoniemi, Implemented PRELES model to R */ +/* 21.6.2012. Mikko Peltoniemi, mikko.peltoniemi@metla.fi + * Citations: Peltoniemi et al., manuscript submitted. + * Contact Mikko for the current status of the manuscript. + * + * Motivation for this model has been to prepare a simple model + * for the prediction of drought effect on GPP that could be + * run at high resolution for broad spatial scales. + * + * Model has been fitted using MCMC to Hyytiälä data, with embedded MCMC code + * of J. Rosenthal (borrowed from amcmc package). Following parameter estimates + * were obtained (highest LL set) + +RUN_PARAMETERS_FOR_MODEL +0 useMeasurement +0 LOGFLAG +SITE_SPECIFIC_PARAMETERS +413.0 soildepth +0.450 ThetaFC +0.118 ThetaPWP +3 tauDrainage +GPP_MODEL_PARAMETERS +0.748464 betaGPP +12.74915 tauGPP +-3.566967 S0GPP +18.4513 SmaxGPP +-0.136732 kappaGPP +0.033942 gammaGPP +0.448975 soilthresGPP +2000 cmCO2 +0.4 ckappaCO2 +EVAPOTRANSPIRATION_PARAMETERS +0.33271 betaET +0.857291 kappaET +0.041781 chiET +0.474173 soilthresET +0.278332 nuET +SNOW_RAIN_PARAMETERS +1.5 Meltcoef +0.33 I_0 +4.824704 CWmax +57, ## t0 fPheno_start_date_Tsum_accumulation; -999 for conif +1.5, ## tcrit, fPheno_start_date_Tsum_Tthreshold, -999 for conif +134 ##tsumcrit, fPheno_budburst_Tsum, -999 for conif + * + * + * + * +*/ + + +/* R interface function, replaces main() */ +void call_preles(// INPUTS + double *PAR, double *TAir, double *VPD, double *Precip, double *CO2, double *fAPAR, + double *GPPmeas, double *ETmeas, double *SWmeas, + // OUTPUTS + double *GPP, double *ET, double *SW, double *SOG, + double *fS, double *fD, double *fW, double *fE, + double *Throughfall, double *Interception, double *Snowmelt, + double *Drainage, + double *Canopywater, double *S, + + //PARAMETERS + double *soildepth, + double *ThetaFC, + double *ThetaPWP, + double *tauDrainage, + double *beta, // START GPP PARAMETERS + double *tau, + double *S0, + double *Smax, + double *kappa, + double *gamma, + double *soilthres, // used for fW with ETmodel = 2 | 4 | 6 + double *bCO2, // used for fW with ETmodel = 1 | 3 | 5 + double *xCO2, // used for fW with ETmodel = 1 | 3 | 5) ; + double *ETbeta, // START ET PARAMETERS + double *ETkappa, + double *ETchi, + double *ETsoilthres, // used for fW with ETmodel = 2 | 4 + double *ETnu, // used for fW with ETmodel = 1 | 3 + double *MeltCoef, // START WATER/SNOW PARAMETERS + double *I0, + double *CWmax, + double *SnowThreshold, + double *T_0, + double *SWinit, // START INITIALISATION PARAMETERS // Soilw water at beginning + double *CWinit, // Canopy water + double *SOGinit, // Snow on Ground + double *Sinit, // State of temperature acclimation + double *t0, + double *tcrit, + double *tsumcrit, + int *etmodel, int *LOGFLAG, int *NofDays, + int *day, + double *transp, + double *evap, + double *fWE) { + + extern int preles(int NofDays, double *PAR, double *TAir, double *VPD, double *Precip, + double *CO2, + double *fAPAR, p1 Site_par, p2 GPP_par, p3 ET_par,p4 SnowRain_par, + int etmodel , + double *GPP, double *ET, double *SW, double *SOG, + double *fS, double *fD, double *fW, double *fE, + double *Throughfall, double *Interception, double *Snowmelt, + double *Drainage, + double *Canopywater, + double *GPPmeas, double *ETmeas, double *SWmeas, double *S, + int LOGFLAG, long int multisiteNday, + int *day, + double *transp, + double *evap, double *fWE) ; + + /* Parameter structs */ + p1 parSite; + p2 parGPP; + p3 parET; + p4 parSnowRain; + + /* Read in model parameters */ + parSite.soildepth = *soildepth; + parSite.ThetaFC = *ThetaFC; + parSite.ThetaPWP = *ThetaPWP; + parSite.tauDrainage = *tauDrainage; + parGPP.beta = *beta; + parGPP.tau = *tau; + parGPP.S0 = *S0; + parGPP.Smax =*Smax; + parGPP.kappa = *kappa; + parGPP.gamma = *gamma; + parGPP.soilthres = *soilthres; + parGPP.bCO2 = *bCO2; + parGPP.xCO2 = *xCO2; + parGPP.t0 = *t0; + parGPP.tcrit = *tcrit; + parGPP.tsumcrit = *tsumcrit; + parET.beta = *ETbeta; + parET.kappa = *ETkappa; + parET.chi = *ETchi; + parET.soilthres = *ETsoilthres; + parET.nu = *ETnu; + parSnowRain.MeltCoef = *MeltCoef; + parSnowRain.I0 = *I0; + parSnowRain.CWmax = *CWmax; + + parSnowRain.SnowThreshold=0; + parSnowRain.T_0=0; + parSnowRain.SnowThreshold=0; + parSnowRain.T_0=0; + + // Forward init values (previous day values) as first values of result vectors + SW[0] = *SWinit; + Canopywater[0] = *CWinit; + SOG[0] = *SOGinit; + S[0] = *Sinit; + + // FILE *flog=NULL; + // if (*LOGFLAG > 0.5) { + // flog = fopen("preles.log", "w"); // EXCEPTION LOGGING + // if (flog) { + // fprintf(flog, "call_preles(): First day weather:\nDOY=%d\tPPFD=%lf\tT=%lf\tVPD=%lf\tP=%lf\tCO2=%lf\n" + // "fAPAR=%lf\tSW=%lf\tCW=%lf\tSOG=%lf\tS=%lf\n", + // day[0], PAR[0], TAir[0], VPD[0], Precip[0], CO2[0],fAPAR[0], + // SW[0], Canopywater[0], SOG[0], S[0]); + // if (*LOGFLAG > 1.5) + // fprintf(flog, + // "call_preles(): Parameters: N=%i\tparGGP.beta=%lf\tparET.chi=%lf\tparSnowRain.SnowThreshold=%lf\tetmodel=%d\nLOGFLAG=%d parGPP.t0=%lf\n", + // *NofDays, parGPP.beta, parET.chi, parSnowRain.SnowThreshold, *etmodel, + // *LOGFLAG, parGPP.t0); + + // } else { + // //exit(1); + // } + // fclose(flog); + // } + + /* Call the workhorse function ------------------------------------------ */ + int notinf = 0; + + + notinf = preles(*NofDays, PAR, TAir, + VPD, Precip,CO2, + fAPAR, parSite, + parGPP, parET, parSnowRain, *etmodel , + GPP, ET, SW, SOG, fS, fD, fW, fE, + Throughfall, Interception, Snowmelt, + Drainage, Canopywater, + GPPmeas, ETmeas, SWmeas, S, *LOGFLAG, *NofDays, day, + transp, evap, fWE); + + // if (*LOGFLAG > 0.5) { + // flog = fopen("preles.log", "a"); // EXCEPTION LOGGING + + + + // if (flog) { + // fprintf(flog, "call_preles(): preles() returned code %d...finishing\n", notinf); + // fclose(flog); + // } else { + // //exit(1); + // } + // } + + +} + diff --git a/src/gpp.c b/src/gpp.c new file mode 100644 index 0000000..12ea8b3 --- /dev/null +++ b/src/gpp.c @@ -0,0 +1,159 @@ +#include "prelesglobals.h" + +/* Seasonality model of Mäkelä et al 2004 */ +double fS_model(double *S, double T, p2 GPP_par) { + double fS; + + *S = *S + (T-*S)/GPP_par.tau; + if (0 > *S-GPP_par.S0) fS=0; else fS= *S-GPP_par.S0; + if (1 < fS/GPP_par.Smax) fS=1; else fS=fS/GPP_par.Smax; + + return(fS); +}; + + +double fPheno_model(p2 GPP_par, double T, double *PhenoS, + int DOY, double fS) { + double m; + double fPheno=0; + + if (GPP_par.t0 > -998) { // ie not -999 + /* Budbreak must occur between specified min. date and end of July */ + if ( (DOY > (GPP_par.t0 - 0.5)) & (DOY < 213) ) { + m = (T - GPP_par.tcrit); + if (m < 0) m = 0; + *PhenoS = *PhenoS + m ; + } else { + *PhenoS = 0; + } + + if (*PhenoS > GPP_par.tsumcrit - 0.005) fPheno = 1; else fPheno = 0; + /* Quick solution to leaf out: + * After end of July we just apply season prediction based on conifer fS + * for gradual leaf out. Assume leaves drop much faster that fS. + * ...essentially this should be light driven process...i think. */ + if (DOY > 212) { + fPheno = fS * fS; + if (fPheno < 0.5) { + fPheno = 0; + } + } + + /* If there is no t0 parameter, it is an evergreen */ + } else { + fPheno = 1; + } + + return(fPheno); +}; + +/* *****************************************************************/ +/* f-modifiers for increasing CO2 prepared by P. Kolari, pers. comm.*/ +/*double fCO2_model_mean(double CO2, p2 GPP_par ) { + return(1 + (CO2-380)/(CO2-380+GPP_par.bCO2)); +} +double fCO2_VPD_exponent(double CO2, p2 GPP_par ) { + return(pow(CO2/380, GPP_par.xCO2)); +} +*/ +/* +double fCO2_model_mean(double CO2, double b ) { + return(1 + (CO2-380)/(CO2-380+b)); +} +double fCO2_VPD_exponent(double CO2, double xCO2 ) { + return(pow(380/CO2, xCO2)); +} +*/ + +/* Note: 'ET_par.bC02' is the same as GPP_par.bCO2 */ +/* +double fCO2_ET_model_mean(double CO2, p2 GPP_par ) { + return(1 - 1.95*(CO2-380)/(CO2-380+(GPP_par.bCO2))); +} +*/ +/* *****************************************************************/ +/* New CO2 modifiers based on APES simulator (Launiainen et al.) + which account for the energy balance of the forest. Fitted responses + to model predicted + bCO2 = 0.5; xCO2 = -0.364 +*/ +double fCO2_model_mean(double CO2, p2 GPP_par ) { + return(1 + GPP_par.bCO2 * log(CO2/380) ); +} +double fCO2_ET_model_mean(double CO2, p2 GPP_par ) { + return(1 + GPP_par.xCO2 * log(CO2/380) ); +} + + + +/* GPP model, modified from Mäkelä et al 2008 */ +void GPPfun(double *gpp, double *gpp380, + double ppfd, double D, double CO2, double theta, + double fAPAR, double fSsub, + p2 GPP_par, p1 Site_par, double *fD, double *fW, + double *fE, int LOGFLAG) { + // double *fE, FILE *flog, int LOGFLAG) { + + extern double fCO2_model_mean(double CO2, p2 b ) ; + // extern double fCO2_VPD_exponent(double CO2, double xCO2 ) ; + double thetavol = theta/Site_par.soildepth; + // double GPPsub, GPP380sub; + double fCO2; + double REW=(thetavol-Site_par.ThetaPWP)/ + (Site_par.ThetaFC-Site_par.ThetaPWP); + double fEsub, fWsub, fLsub, fDsub; + // double fECO2sub, fDCO2sub, fWCO2sub; + + /* Calculate first the reference condition (ca=380 ppm) effect */ + fDsub = exp(GPP_par.kappa * D); + fDsub = fDsub > 1 ? 1 : fDsub; + + if (GPP_par.soilthres < -998) { + fWsub = 1.0; /* e.g. -999 means no water control of GPP*/ + } else { + if (REW < GPP_par.soilthres) { + if (REW > 0.01) fWsub = REW/GPP_par.soilthres; else fWsub = 0.0; + } else { + fWsub = 1.0; + } + } + + fLsub = 1 / (GPP_par.gamma * ppfd + 1); + + if (fDsub > fWsub) fEsub=fWsub; else fEsub = fDsub; + *fW = fWsub; + *fD = fEsub; + + *gpp380 = GPP_par.beta * ppfd * fAPAR * fSsub * fLsub * fEsub; + fCO2 = fCO2_model_mean(CO2, GPP_par); + *gpp = *gpp380 * fCO2; + + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " gpp(): Modifiers: fAPAR %lf\tfSsub %lf\t fLsub %lf\t fDsub %lf\t fWsub %lf\tfEsub %lf\t fCO2 %lf\n gpp380 %lf\t gpp %lf\n", + // fAPAR, fSsub, fLsub, fDsub, fWsub, fEsub, fCO2, *gpp380, *gpp); + + + + /* This has been removed, and simpler multiplicative CO2 modifier to gpp380 is used. + * CO2 effect not only influences fD but also fW, due to stomatal action + + fDCO2sub = fDsub * pow(exp(-0.4 * D), + fCO2_VPD_exponent(CO2, GPP_par.xCO2)) / exp(-0.4 * D) ; + fWCO2sub = fWsub * pow(fWsub, fCO2_VPD_exponent(CO2, GPP_par.xCO2)); + + if (LOGFLAG > 1.5) + fprintf(flog, + " gpp(): Modifier values for GPP at %lf\n fD=%lf\tfW=%lf\tfCO2mean=%lf\n", + CO2, fDCO2sub, fWCO2sub, fCO2_model_mean(CO2, GPP_par.bCO2)); + + if (fDCO2sub > fWCO2sub) fECO2sub=fWCO2sub; else fECO2sub = fDCO2sub; + + *fECO2 = fECO2sub; + + *gpp = GPP_par.beta * ppfd * fAPAR * fSsub * fLsub * fECO2sub * + fCO2_model_mean(CO2, GPP_par.bCO2); +*/ + +} diff --git a/src/initruns.c b/src/initruns.c new file mode 100644 index 0000000..48b222b --- /dev/null +++ b/src/initruns.c @@ -0,0 +1,14 @@ +#include "prelesglobals.h" + +/* Replace missing first day values with something reasoble if missing */ +void initConditions(double **PAR, double **TAir, double **VPD, double **Precip, + double **CO2) { + /* if first day value is missing assume we're somewhere on the boreal + * zone (lat > 60 deg) */ + if ( **PAR < -900) **PAR=5; // it was a dark winter day... + if ( **TAir < -900) **TAir=0; + if ( **VPD < 0 || **VPD > 6) **VPD=0.5; // VPD > 6 implausible, 3 = very dry air + if ( **Precip < 0) **Precip=0; + if ( **CO2 < 0.1) **CO2=380; // + +}; diff --git a/src/preles.c b/src/preles.c new file mode 100644 index 0000000..9f0506c --- /dev/null +++ b/src/preles.c @@ -0,0 +1,258 @@ +#include "prelesglobals.h" + +/* Model function: + * 1. Makes initialisations + * 2. Estimates GPP + * 3. Estimates snow and interception + * 4. Estimates Evapotranspiration + * 5. Updates soil water balance +*/ + +int preles(int NofDays, + double *PAR, double *TAir, double *VPD, double *Precip, + double *CO2, + double *fAPAR, p1 Site_par, + p2 GPP_par, p3 ET_par, p4 SnowRain_par, int etmodel, + double *GPP, double *ET, double *SW, double *SOG, + double *fS, double *fD, double *fW, double *fE, + double *Throughfall, double *Interception, double *Snowmelt, + double *Drainage, double *Canopywater, + double *GPPmeas, double *ETmeas, double *SWmeas, double *S, + int LOGFLAG, long multisiteNday, int *day, + double *transp, + double *evap, double *fWE){ + + extern double fS_model(double *S, double T, p2 GPP_par); + extern double fPheno_model(p2 GPP_par, double T, double *PhenoS, + int DOY, double fS); + + + + extern double ETfun(double D, double theta, double ppfd, double fAPAR, + double T, + p3 ET_par, p1 Site_par, + double *canw, + double *fE, double A, + double fWgpp, p2 GPP_par, //double fCO2mean, + double CO2, + int LOGFLAG, int etmodel, // FILE *flog, int LOGFLAG, int etmodel, + double *transp, + double *evap, double *fWE); + + extern void interceptionfun(double *rain, double *intercepted, double Temp, p4 + SnowRain_par, double fAPAR); + extern void swbalance(double *theta, double throughfall, + double snowmelt, double et, + p1 sitepar, double *drainage, + double *snow, double *canw, p4 SnowRain_par); + extern void Snow(double T, double *rain, double *snow, p4 SnowRain_par, + double *SnowMelt); + extern void initConditions(double **PAR, double **TAir, + double **VPD, double **Precip, + double **CO2); + + extern void GPPfun(double *gpp, double *gpp380, double ppfd, + double D, double CO2, + double theta, + double fAPAR, double fSsub, + p2 GPP_par, p1 Site_par, double *fD, double *fW, + // double *fE, FILE *flog, int LOGFLAG); + double *fE, int LOGFLAG); + + //extern double fCO2_VPD_exponent(double CO2, double xCO2 ) ; + + + + //extern double fCO2_ET_VPD_correction(double fEgpp, double xCO2 ); + //extern double fCO2_model_mean(double CO2, double bCO2 ) ; + + + // FILE *flog=NULL; + // flog = fopen("preles.log", "a"); // EXCEPTION LOGGING + + // if (LOGFLAG > 0.5) fprintf(flog, " Stepped into preles()"); + + double I, T, D, P, theta, theta_snow, theta_canopy, S_state; + double PhenoS=0; + double fPheno=0; + int i; + double fEgpp = 0; + double gpp380 = 0; + + + initConditions(&PAR, &TAir, &VPD, &Precip, &CO2); + theta=SW[0]; + theta_canopy=Canopywater[0]; + theta_snow=SOG[0]; + S_state = S[0]; + + + // if (LOGFLAG > 1.5) { + // fprintf(flog, " preles(): Starting values for storage components:\nSW=%lf\tCW=%lf\tSOG=%lf\tS=%lf\n" + // " ...will loop %d rows of weather input\n", + // theta, theta_canopy, theta_snow, S[0], NofDays); + // printf(" preles(): Site fAPAR =%lf, LUE = %lf and soil depth = %lf.\n", + // fAPAR[0], GPP_par.beta, Site_par.soildepth); + // } + // fclose(flog); + + + + + + + /* ---------------------------------------------------------------------*/ + /* START LOOPING DAYS---------------------------------------------------*/ + /* ---------------- ----------------------------------------------------*/ + for (i=0; i < NofDays; i++) { + + // if ((LOGFLAG > 1.5)) { + // fprintf(flog, " \ni=%d/%d,\t SW=%lf\tCW=%lf\tSOG=%lf\tS=%lf\n", + // i+1, NofDays, theta, theta_canopy, theta_snow, S_state); + // } + + /* Use previous day environment for prediction, if current values are missing, + or suspicious*/ + if (i > 0) { + if (PAR[i] < -900) PAR[i] = PAR[i-1]; + if (TAir[i] < -900) TAir[i] = TAir[i-1]; + if (VPD[i] < 0 || VPD[i] > 6) VPD[i] = VPD[i-1]; + if (Precip[i] < 0) Precip[i] = Precip[i-1] * 0.3; + /* On avg. P+1=0.315*P + * (in Sodis & Hyde) */ + if (CO2[i] < 0) CO2[i] = CO2[i-1]; + if (GPPmeas[i] < -990) GPPmeas[i] = GPPmeas[i-1]; + if (ETmeas[i] < -990) ETmeas[i] = ETmeas[i-1]; + if (SWmeas[i] < 0.0) SWmeas[i] = SWmeas[i-1]; + if (SW[i] < -900) SW[i] = SW[i-1]; + if (SOG[i] < -900) SOG[i] = SOG[i-1]; // See above, could be used for + // calibration + } + + + // if ((LOGFLAG > 1.5)) { + // fprintf(flog, " weather inputs: PAR=%lf\tT=%lf\tVPD=%lf\tP=%lf\tCO2=%lf\n", + // PAR[i], TAir[i], VPD[i], Precip[i], CO2[i]); + // } + + /* Assign current values for environment */ + I = PAR[i]; T=TAir[i]; D=VPD[i]; P=Precip[i]; + /* Update temperature state that tells about seasonality - + * for GPP and through GPP to ET */ + fS[i] = fS_model(&S_state, T, GPP_par); + + // if (LOGFLAG > 1.5) fprintf(flog, " preles(): estimated fS=%lf\n", fS[i]); + + + /* Deciduous phenology - don't use if this information is inputted in fAPAR */ + /* Note also that fapar is multiplied by 0 or 1 (i.e. leaf development is not accounted for) */ + /* Model predicts budbreak based on critical threshold temperature sum */ + /* Note that this implementation works only if data starts before t0-date of fPheno-model */ + // if (LOGFLAG > 1.5) fprintf(flog, + // " preles(): stepping into fPheno_model: inputs:\n GPP_par.t0=%lf\tT=%lf\tPhenoS=%lf\tDOY=%d\n", + // GPP_par.t0, T, PhenoS, day[i]); + + fPheno = fPheno_model(GPP_par, T, &PhenoS, day[i], fS[i]); + // if (LOGFLAG > 1.5) fprintf(flog, " preles(): PhenoS=%lf\tfPheno=%lf\n", + // PhenoS, fPheno ); + + fAPAR[i] = fAPAR[i] * fPheno; + // if (LOGFLAG > 1.5) fprintf(flog, + // " preles(): fAPAR changed to %lf\n", + // fAPAR[i]); + + + GPPfun(&GPP[i], &gpp380, I, D, CO2[i], theta, fAPAR[i], fS[i], + GPP_par, Site_par, &fD[i], &fW[i], &fEgpp, + LOGFLAG ); + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " preles(): estimated GPP=%lf\tfD=%lf\tfEgpp=%lf\n GPP380ppm %lf\n", + // GPP[i], fD[i], fEgpp, gpp380); + + + /* Calculate amount of snow and snowmelt at the end of the day */ + Snow(T, &P, &theta_snow, SnowRain_par, &Snowmelt[i]); + + // NOTE: interception model could be better + Throughfall[i] = P; + interceptionfun(&Throughfall[i], &Interception[i], T, + SnowRain_par, fAPAR[i]); + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " preles(): estimated Thr.fall=%lf\tIntercept.=%lf\tSOG=%lf\tSnowmelt=%lf\n", + // Throughfall[i], Interception[i], SOG[i], Snowmelt[i]); + + /*Excess water from canopy will drip down to soil if not evaporated + during the day, rest remains in canopy for the next day*/ + + if (SnowRain_par.CWmax <= 0.00000001) { + Throughfall[i] = Throughfall[i] + Interception[i]; + } else { + if (Interception[i] + theta_canopy > SnowRain_par.CWmax * fAPAR[i]) { + Throughfall[i] = Throughfall[i] + Interception[i] + + theta_canopy - SnowRain_par.CWmax * fAPAR[i]; + theta_canopy = SnowRain_par.CWmax * fAPAR[i]; + } else { + theta_canopy = Interception[i] + theta_canopy; + } + } + + // if (LOGFLAG > 1.5) + // fprintf(flog, " preles(): estimated canopy water=%lf\n", + // theta_canopy); + + + ET[i] = ETfun(D, theta, I, fAPAR[i], T, + ET_par, Site_par, + &theta_canopy, + &fE[i], // Soil water constrain on evaporation + gpp380, + fW[i], // soil water constrain of GPP at 380 ppm + GPP_par, //fCO2_ET_model_mean(CO2[i], GPP_par), + CO2[i], + LOGFLAG, etmodel, + &transp[i], + &evap[i], &fWE[i]); + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " preles(): ET=%lf\n", ET[i]); + + + /* Calculate soil water balance, drainage and related variables at the + end of the day, as well as update snow and canopy water with et */ + + // swbalance(&theta, Throughfall[i], Snowmelt[i], ET[i], + swbalance(&theta, Throughfall[i], Snowmelt[i], ET[i], + Site_par, &Drainage[i], //&Psi[i], &Ks[i], + &theta_snow, &theta_canopy, SnowRain_par); + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " preles(): drainage=%lf, after ET: SW=%lf\tSOG=%lf\tCW=%lf\n", + // Drainage[i], theta, theta_snow, theta_canopy); + + /* Record result variables with storage components */ + SOG[i] = theta_snow; + SW[i] = theta; + Canopywater[i] = theta_canopy; + S[i]=S_state; + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " preles(): after day state:\n SW=%lf\tCW=%lf\tSOG=%lf\tS=%lf\n\n", SW[i], Canopywater[i], SOG[i], S[i]); + + + } // END DAY LOOP + + + // if (LOGFLAG > 1.5) + // fprintf(flog, + // " preles(): looped all days, closing preles.log, exiting...\n"); + // if (flog) fclose(flog); + return(0); +} + diff --git a/src/prelesglobals.h b/src/prelesglobals.h new file mode 100644 index 0000000..474d189 --- /dev/null +++ b/src/prelesglobals.h @@ -0,0 +1,89 @@ + +#ifndef PRELESGLOBALS_H +#define PRELESGLOBALS_H + +#include +#include +#include +#include +#include + +#define TARGACCEPT 0.44 +#define MAXK 1000 +#define MYINFINITY 999999999.9 +#define PI 3.1415926535 +#define NUMBER_OF_MODEL_PARAMETERS 38 + +int K; +int vectorlength; + +/* Site soil and other parameters, some in input, some calculated in code */ +typedef struct p1 { + double soildepth; + double ThetaFC; + double ThetaPWP; + double tauDrainage; +} p1 ; + +// GPP model +typedef struct p2 { + double beta; + double tau; + double S0; + double Smax; + double kappa; + double gamma; + double soilthres; // used for fW with ETmodel = 2 | 4 | 6 + double bCO2; // used for fW with ETmodel = 1 | 3 | 5 + double xCO2; // used for fW with ETmodel = 1 | 3 | 5; + double t0; // Birch phenology parameters: 26th Feb = 57 DOY + double tcrit; // (Linkosalo et al) 1.5 C + double tsumcrit; // 134 C + +} p2 ; + +// ET-model +typedef struct p3 { + double beta; + double kappa; + double chi; + double soilthres; // used for fW with ETmodel = 2 | 4 + double nu; +} p3 ; + +// Rain and Snow models: interception and melting of snow +typedef struct p4 { + double MeltCoef; + // double Ifrac; + double I0; + double CWmax; + double SnowThreshold; + double T_0; +} p4; + +// Storage components +typedef struct p5 { + double SW; // Soilw water at beginning + double CW; // Canopy water + double SOG; // Snow on Ground + double S; // State of temperature acclimation +} p5; + +typedef struct p6 { + double cvGPP; // Coefficients of variation for GPP, ET and SW + double cvET; // Used in MCMC-calibration only + double cvSW; +} p6; + + +#ifdef __cplusplus +extern "C" { +#endif + + +#ifdef __cplusplus +} +#endif + +#endif /* PRELESGLOBALS_H */ + diff --git a/src/water.c b/src/water.c new file mode 100644 index 0000000..d0ab58e --- /dev/null +++ b/src/water.c @@ -0,0 +1,252 @@ +#include "prelesglobals.h" + +/* Estimate Evapotranspiration according to a simple empirical model + * that uses GPP prediction to calculate transpiration, as driven + * by VPD. Evaporation is estimated with PPFD, which is a surrogate + * for Rnet */ +double ETfun(double D, double theta, double ppfd, double fAPAR, double T, + p3 ET_par, p1 Site_par, + double *canw, + double *fE, double A, + double fWgpp, p2 GPP_par, //double fCO2mean, + double CO2, + int LOGFLAG, int etmodel, double *transp, + // FILE *flog, int LOGFLAG, int etmodel, double *transp, + double *evap, double *fWE) { + + extern double fCO2_ET_model_mean(double CO2, p2 GPP_par ); + + double pow(); + double thetavol = theta/Site_par.soildepth; + double REW=(thetavol-Site_par.ThetaPWP)/ + (Site_par.ThetaFC-Site_par.ThetaPWP); + // double fEsub = -999; /* Minimum of fW and fD returned if ET-model + // * flag indicates similar modifier as for GPP */ + double fWsub=1; + // double fDsub=1; + double et; + double fCO2mean; + double lambda, psychom, s; //, rho; + double cp = 1003.5; // J/(kg K) (nearly constant, this is dry air on sea level) + double MWratio = 0.622; // Ratio of molecular weigths of water vapor and dry air; + // double R = 287.058; // J/(kg K) Specific gas constant for dry air, wiki + // double zh, zm, d, zom, zoh; + /*If pressure is not inputted use default */ + double pressure = 101300; // Pa + + fCO2mean = fCO2_ET_model_mean(CO2, GPP_par); + + // rho=pressure/(R * (T+273.15) ); // Dry air density, kg/m3 + lambda = (-0.0000614342 * pow(T, 3) + 0.00158927 * pow(T, 2) - + 2.36418 * T + 2500.79) * 1000; // J/kg + psychom= cp * pressure / (lambda* MWratio); // Pa/C, wiki + s = 1000 * 4098.0 * (0.6109 * exp((17.27 * T)/(T+237.3))) / + pow(T+237.3, 2); // Pa/C! (Ice has nearly the same slope) + + + /* Calculate soil constraint, simple linear following Granier 1987*/ + if (ET_par.soilthres < -998) { /*-999 omits water control*/ + fWsub = 1; + } else { + if (REW < ET_par.soilthres) { + if (REW > 0.01) fWsub = REW/ET_par.soilthres; else fWsub = 0.0; + } else { + fWsub = 1.0; + } + } + + + /* If there is any water in canopy, evaporation is not reduced by + * low soil water */ + if (*canw > 0.00000001) fWsub = 1; + + // if (fDsub > fWsub) fEsub=fWsub; else fEsub = fDsub; + + *fE = fWsub; + *fWE = fWsub; + + if (D < 0.01) D=0.01; + + // if (LOGFLAG > 1.5) + // fprintf(flog, " ETfun(): CO2mean=%lf\tat CO2=%lf\n", + // fCO2mean, CO2); + + if (etmodel == -1) { + *transp = D * ET_par.beta*A/pow(D, ET_par.kappa) * + pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + fCO2mean; + *evap = ET_par.chi * (1-fAPAR) * fWsub * ppfd; + et = (*transp + *evap) * s / (s + psychom); + } + + if (etmodel == 0) { + *transp = D * ET_par.beta*A/pow(D, ET_par.kappa) * + pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + fCO2mean; + *evap = ET_par.chi * s / (s + psychom) * (1-fAPAR) * fWsub * ppfd; + // et = D * ET_par.beta*A/pow(D, ET_par.kappa) * + // pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + // fCO2mean + // Mean effect of CO2 on transpiration + // ET_par.chi * s / (s + psychom) * (1-fAPAR) * fWsub * ppfd; + et = *transp + *evap; + } + if (etmodel == 1) { + *transp = D * ET_par.beta*A/pow(D, ET_par.kappa) * + pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + fCO2mean; + *evap = ET_par.chi * (1-fAPAR) * fWsub * ppfd; + //et = D * ET_par.beta*A/pow(D, ET_par.kappa) * + // pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + // fCO2mean + // Mean effect of CO2 on transpiration + // ET_par.chi * (1-fAPAR) * fWsub * ppfd; + et = *transp + *evap; + } + if (etmodel == 2) { + et = D * (1 + ET_par.beta/pow(D, ET_par.kappa)) * A / CO2 * + pow(fWgpp, ET_par.nu) * // ET differently sensitive to soil water than GPP + fCO2mean + // Mean effect of CO2 on transpiration + ET_par.chi * (1-fAPAR) * fWsub * ppfd; + } + + // if (LOGFLAG > 2.5) + // fprintf(flog, " ETfun(): Model=%d\nD\t%lf\nET_par.beta\t%lf\nA\t%lf\npow(D, ET_par.kappa)\t%lf\npow(fWgpp, ET_par.nu)\t%lf\nfWgpp\t%lf\nET_par.nu\t%lf\nfCO2mean\t%lf\nCO2\t%lf\nET_par.chi\t%lf\ns/(s+psychom)\t%lf\n1-fAPAR\t%lf\nfWsum\t%lf\nppfd\t%lf\n-->et\t%lf\n", + // etmodel, D, ET_par.beta, A, pow(D, ET_par.kappa), + // pow(fWgpp, ET_par.nu), fWgpp, ET_par.nu, + // fCO2mean, + // CO2, + // ET_par.chi , s / (s + psychom), 1-fAPAR, fWsub, ppfd, et); + + + return(et); +} + + +/*Interception is a fraction of daily rainfall, fraction depending on fAPAR*/ +void interceptionfun(double *rain, double *intercepted, double Temp, p4 + SnowRain_par, double fAPAR) { + if (Temp > SnowRain_par.SnowThreshold) { + *intercepted = *rain * (SnowRain_par.I0 * fAPAR / 0.75); + *rain = *rain - *intercepted; + } else { + *intercepted = 0; + } +} + + + + +/* Soil water balance is updated with snowmelt and canopy throughfall + * and evapotranspiration. No drainage occurs below field capacity */ +void swbalance(double *theta, double throughfall, double snowmelt, double et, + p1 sitepar, double *drainage, + double *snow, double *canw, p4 SnowRain_par) { + double st0, etfromvegandsoil=0; + + /* Evaporate first from wet canopy and snow on ground */ + + if (SnowRain_par.CWmax > 0.00000001) { + if ( (*canw + *snow - et) > 0 ) { + if ( (*canw - et) > 0 ) { + *canw = *canw -et; + etfromvegandsoil = 0; + } else if (*canw - et < 0) { // in this case, there's enough snow left + *snow = *snow + *canw - et; + *canw = 0; + etfromvegandsoil = 0; + } + } else { + etfromvegandsoil = et - *canw - *snow; + *canw=0.0; + *snow = 0.0; + } + + } else { + if ( (*snow - et) > 0 ) { + *snow = *snow - et; + etfromvegandsoil = 0; + } else if (*snow - et < 0) { // in this case, there's enough snow left + etfromvegandsoil = et - *snow; + *snow = 0; + } else { + *snow = 0.0; + } + } + + et = etfromvegandsoil; + + /* Water balance without drainage */ + st0 = *theta + throughfall + snowmelt - et; + if (st0 <= 0) st0 = 0.0001; + + /* Calculate what is left to drainage after partial balance update above: */ + if (sitepar.tauDrainage > 0) { + + + // Simple time delay drainage above FC: + if (st0 > sitepar.ThetaFC * sitepar.soildepth) { + *drainage = (st0 - sitepar.ThetaFC * sitepar.soildepth) / + sitepar.tauDrainage; + } else { + *drainage = 0; + } + *theta = st0 - *drainage; + + + /* Include marginal drainage below FC. + * This was needed for model calibration only, below FC drainage + * was practically zero, but important for convergence */ + /* +if (st0 > sitepar.ThetaFC * sitepar.soildepth) { + *drainage = (st0 - sitepar.ThetaFC * sitepar.soildepth) / + sitepar.tauDrainage; + } + if (*drainage < (sitepar.ThetaFC * sitepar.soildepth - + sitepar.ThetaPWP * sitepar.soildepth) / + 10000) //pow(sitepar.tauDrainage, 5)) + *drainage = (sitepar.ThetaFC * sitepar.soildepth - + sitepar.ThetaPWP * sitepar.soildepth) / + 10000; //pow(sitepar.tauDrainage, 5); + + if (st0 <= sitepar.ThetaFC * sitepar.soildepth && + st0 > sitepar.ThetaPWP * sitepar.soildepth) { + *drainage = (st0 - sitepar.ThetaPWP * sitepar.soildepth) / + 10000; //pow(sitepar.tauDrainage, 5); + *theta = st0 - *drainage; + } + + if (st0 <= sitepar.ThetaPWP * sitepar.soildepth) { + *drainage = 0; + *theta = st0; + } + *theta = st0 - *drainage; + */ + //****************************************************** */ + + + } + +} + + +/* Rain is snow below T > 0 C, and snow melts above O C. */ +void Snow(double T, double *rain, double *snow, p4 SnowRain_par, + double *SnowMelt) { + double NewSnow; + if (T < SnowRain_par.SnowThreshold) { + NewSnow=*rain; + *rain = 0; + } else { + NewSnow=0; + } + + if (T > SnowRain_par.T_0) + *SnowMelt = SnowRain_par.MeltCoef*(T-SnowRain_par.T_0); + else *SnowMelt=0; + + if (*snow + NewSnow - *SnowMelt < 0) { + *SnowMelt=NewSnow + *snow; + *snow =0; + } else { + *snow = *snow + NewSnow - *SnowMelt; + } +}; diff --git a/tests/testrun.R b/tests/testrun.R new file mode 100644 index 0000000..002647d --- /dev/null +++ b/tests/testrun.R @@ -0,0 +1,46 @@ +library(Rpreles) +data(hydata) +hydata[is.na(hydata)] <- -999 + +daterange = 1:365 +DOY <- daterange +n = length(daterange) + +CO2 <- rep(376, len=n) +T=hydata[daterange, 'TAir'] +Precip=hydata[daterange, 'Precip'] +PAR=hydata[daterange, 'PPFD'] +## Fake VPD +D=sin(pi*(1:n)/n) + 0.01 +D = tapply(D, 1:n, function(x) runif(1, x/4, x*1.5)) +fAPAR=rep(0.765, len=n) + +## CONIFER EXAMPLE +## This is the default set for conifers, based on calibration to 10 sites +defaults = c(413, 0.45, 0.118, 3, 0.7457, 10.93, -3.063, + 17.72, -0.1027, 0.03673, 0.7779, 0.5, -0.364, 0.2715, + 0.8351, 0.07348, 0.9996, 0.4428, 1.2, 0.33, 4.970496, + 0, 0, 160, 0, 0, 0, -999, -999, -999) + +o1 <- PRELES(PAR, T, D, Precip, CO2, fAPAR, DOY=DOY, p=defaults, + returncols=c("GPP", "ET", "fS", "fW", "SW", + "Canopywater", "SOG", "S"), LOGFLAG=0) + +## DECIDUOUS EXAMPLE (birch) +decid <- defaults +decid[1:3] <- c(700, 0.45, 0.05) # Soil usually moister +decid[5] <- 0.94 # LUE usually higher (estimated based on linear [N]-LUE relation) +decid[9] <- -0.4 # But kappa for VPD more negative, meaning more responsive to VPD +decid[24:27] <- c(decid[1]*(decid[2]-decid[3]), 0, 0, 0) #SW; CW; SOG; S +decid[28:30] <- c(57, 1.5, 134) # Phenol. mod. (Linkosalo et al. 2008) modifies fAPAR (0/1) + +o2 <- PRELES(PAR, T, D, Precip, CO2, fAPAR, DOY=DOY, p=decid, + returncols=c("GPP", "ET", "fS", "fW", "SW", + "Canopywater", "SOG", "S"), pft="notconifer", + LOGFLAG=0) + +measuredGPP = hydata$GPP[daterange] +measuredGPP[measuredGPP < -998] <- NA +plot(DOY, measuredGPP) +points(DOY, o1$GPP, col=2) +points(DOY, o2$GPP, col=3)