From 7d6d81fa96bdae8ec9649e3fc2253263dc241207 Mon Sep 17 00:00:00 2001 From: Hollos Roland Date: Mon, 4 Apr 2022 16:08:49 +0200 Subject: [PATCH] CIRM for article --- docs/CIRM/README.md | 72 ++++++ docs/CIRM/glue.R | 55 +++++ docs/CIRM/kichen_sink.R | 45 ++++ docs/CIRM/make_individual_trees.R | 131 ++++++++++ docs/CIRM/statistics.R | 76 ++++++ docs/CIRM/tree_accuracy.R | 70 ++++++ test.R | 382 ++++++++++++++++++++++++++++++ 7 files changed, 831 insertions(+) create mode 100644 docs/CIRM/README.md create mode 100644 docs/CIRM/glue.R create mode 100644 docs/CIRM/kichen_sink.R create mode 100644 docs/CIRM/make_individual_trees.R create mode 100644 docs/CIRM/statistics.R create mode 100644 docs/CIRM/tree_accuracy.R create mode 100644 test.R diff --git a/docs/CIRM/README.md b/docs/CIRM/README.md new file mode 100644 index 0000000..e84e865 --- /dev/null +++ b/docs/CIRM/README.md @@ -0,0 +1,72 @@ +This is a si + +## Preparations + +### Loading the RBBGCMuso package and the necessary functions + +```{r} +library(RBBGCMuso) +source("make_individual_trees.R") # The DT creation and update algorithms +source("glue.R") # GLUE optimizer algorithms +``` + +The file containing the path to the observation files (Martonvasar_maize.obs), and the parameter intervals (Martonj) + +### Reading the observations + +The mean yield had to be adjust. see in art. + +```{r} +measureFile <- "Martonvasar_maize.obs" +measurements <- read.csv2(measureFile, stringsAsFactors=FALSE) +measurements$mean <- measurements$mean / 10000 * 0.85 +measurements$sd <- measurements$sd / 10000 * 0.85 +``` + +### Define conditioning functions + +constraints.json + +```{json} +{ + "constraints": [ + + { + "Expression": "SELECT(harvest_index, max)|median", + "Min": 0.45, + "Max": 0.55 + }, + { + "Expression": "SELECT(proj_lai, max)|quantile(.,0.5)", + "Min": 2.7, + "Max": 5 + }, + { + "Expression": "SELECT(rootdepth5, max)|quantile(.,0.5)", + "Min": 1.40, + "Max": 1.80 + }, + { + "Expression": "SELECT(flower_date, max)|quantile(.,0.5)", + "Min": 180, + "Max": 190 + } + ], + + "treshold": 80 +} +``` + +```{r} +constraints <- jsonlite::read_json("constraints.json",simplifyVector=TRUE) +``` + +### Cal file: + +```{verbatim} + +Martonvasar_maize.obs +Martonvasar_maize.set +site +Martonvasar_maize;211 +``` diff --git a/docs/CIRM/glue.R b/docs/CIRM/glue.R new file mode 100644 index 0000000..5caa7a2 --- /dev/null +++ b/docs/CIRM/glue.R @@ -0,0 +1,55 @@ +zero_var <- function(m){ + apply(m,2, function(v){ + var(v) != 0 + }) + +} + + +glue <- function(results="result.csv",res_r="results.RDS",output ="gplot.pdf",epcname="maize_glue.epc"){ + res <- read.csv(results)[-1] + res <- res[-1,] + colnames(res) + non_zero <- res[,1:(ncol(res)-4)] + colnames(non_zero) <- colnames(res)[1:(ncol(res)-4)] + impvars <- zero_var(non_zero) + nonzero <- non_zero[,impvars] + likelihoods <- res[,(ncol(res)-3)] + rmse <- res[,(ncol(res)-2)] + const <- res$Const + namess <- gsub("__.*","",colnames(nonzero)) + + + + + likelihoods <- likelihoods[res$Const==1] + goods <- res[res$Const==1,] + medlik <- median(likelihoods[likelihoods >= quantile(likelihoods,0.95)]) + medlik_place <- which.min(abs(likelihoods - medlik)) + parameters <- readRDS(res_r) + glue_opt <- goods[medlik_place, 1:(ncol(res)-4)][impvars] + nonka <- goods[likelihoods >= quantile(likelihoods,0.95),1:(ncol(res)-4)] + med_opt <- apply(nonka,2,median)[impvars] + # med_opt <- apply(nonka,2,mean)[impvars] + ml_opt <- goods[which.max(likelihoods),1:(ncol(res)-4)][impvars] + + calibrationPar <- parameters$calibrationPar[impvars] + changemulline(src="maize.epc", calibrationPar = calibrationPar, contents=glue_opt, outFiles = epcname) + changemulline(src="maize.epc", calibrationPar = calibrationPar, contents=med_opt, outFiles = "maize_median.epc") + changemulline(src="maize.epc", calibrationPar = calibrationPar, contents=ml_opt, outFiles = "maize_ml.epc") + + + + print(output) + pdf(output) + for(i in 1:ncol(nonzero)){ + plot(nonzero[,i],res[,(ncol(res)-3)],main="",col="lightgray", pch=20, cex=0.4, xlab=namess[i],ylab="logLikelihood") + points(nonzero[const==1,i],res[const==1,(ncol(res)-3)],pch=20, cex=0.6, col="red",type="p",xlab=namess[i],ylab="logLikelihood") + abline(v=glue_opt[i],col="green") + abline(v=med_opt[i],col="blue") + abline(v=ml_opt[i],col="black") + } + + dev.off() +} + diff --git a/docs/CIRM/kichen_sink.R b/docs/CIRM/kichen_sink.R new file mode 100644 index 0000000..2103be5 --- /dev/null +++ b/docs/CIRM/kichen_sink.R @@ -0,0 +1,45 @@ +start_intervals <- read.csv("1/Martonvasar_maize.set",skip=1,stringsAsFactors=FALSE) + +indices <- which(start_intervals[,3] != start_intervals[,4]) + +png("kichen_sink.png",width=30,height=30,res=600,units = "cm") + +par(mfrow=c(5,4)) + +for(i in indices){ + ranges <- start_intervals[i,3:4] + optimes <- numeric(10) + for(j in 1:10){ + base_table <- read.csv(paste(j,"Martonvasar_maize_after_tree.set",sep="/"), + skip=1, stringsAsFactors=FALSE) + ranges <- rbind(ranges,base_table[i,3:4]) + optimes[j] <- unlist(readRDS(paste0(j,"/results.RDS"))$parameters[start_intervals[indices,1]][indices==i]) + } + plot(ranges[,1],11:1,type="l",xlim=range(ranges),main=base_table[i,1],xlab="",ylab="iterations",yaxt="n") + axis(2,at=11:1,labels = 0:10) + points(optimes,10:1) + lines(ranges[,2],11:1,type="l") +} +dev.off() + +postscript("kichen_sink.eps",paper="a4") + +par(mfrow=c(5,4)) + +for(i in indices){ + ranges <- start_intervals[i,3:4] + optimes <- numeric(10) + for(j in 1:10){ + base_table <- read.csv(paste(j,"Martonvasar_maize_after_tree.set",sep="/"), + skip=1, stringsAsFactors=FALSE) + ranges <- rbind(ranges,base_table[i,3:4]) + optimes[j] <- unlist(readRDS(paste0(j,"/results.RDS"))$parameters[start_intervals[indices,1]][indices==i]) + } + plot(ranges[,1],11:1,type="l",xlim=range(ranges),main=base_table[i,1],xlab="",ylab="iterations",yaxt="n") + axis(2,at=11:1,labels = 0:10) + points(optimes,10:1) + lines(ranges[,2],11:1,type="l") +} +dev.off() + + diff --git a/docs/CIRM/make_individual_trees.R b/docs/CIRM/make_individual_trees.R new file mode 100644 index 0000000..e7950bf --- /dev/null +++ b/docs/CIRM/make_individual_trees.R @@ -0,0 +1,131 @@ +library(rpart) +library(rpart.plot) +zero_var <- function(m){ + apply(m,2, function(v){ + var(v) != 0 + }) + +} + +decbin <- function(decnum){ + if(decnum < 2){ + return(decnum) + } + c(decbin((decnum %/% 2)),decnum %% 2) +} + +decpad <- function(decnum,len){ + binrep <- decbin(decnum) + c(rep(0,len-length(binrep)),binrep) +} + + +tree_per_const <- function(results="result.csv",output ="tree_per_const.pdf", + parameters_file="Martonvasar_maize.set"){ + varname <-readLines(parameters_file)[1] + parameters <- read.csv(parameters_file,skip=1,stringsAsFactors=FALSE) + + + results <- read.csv(results, stringsAsFactors=FALSE) + # likelihoods <- results[,ncol(results)-3] + # results <- results[likelihoods>=quantile(likelihoods,0.95),] + len <- round(log(max(results$failType),2)) + failTypes <- do.call(rbind,lapply(results$failType,function(x){decpad(x,len)})) + pdf(output) + sapply(1:len, function(const){ + nonzero <- results[,1:(ncol(results)-4)] + nonzero <- nonzero[,-1] + nonzero <- nonzero[,zero_var(nonzero)] + colnames(nonzero) <- gsub("__.*","",colnames(nonzero)) + constraint <- failTypes[,const] + baseTable <- cbind.data.frame(nonzero,constraint = as.factor(constraint)) + try({ + rp = rpart(constraint ~ .,data = baseTable) + }) + try({ + parameters <<- update_parameters_based_on_tree(rp, parameters) + }) + try({ + rpart.plot(rp) + }) + + + }) + dev.off() + outname <- paste0(tools::file_path_sans_ext(parameters_file),"_after_tree.", + tools::file_ext(parameters_file)) + writeLines(varname,outname) + write.table(parameters,outname,row.names=FALSE,append=TRUE,sep=",",quote=FALSE) +} +update_parameters_based_on_tree <- function(rp, parameters){ + frm <- rp$frame + nodes <- labels(rp) + names(nodes) <- row.names(frm) + node <- get_start_node(frm) + parameters <- change_parameters_on_node(nodes,node,parameters) + while(node !=1){ + node <- get_parent_node(node) + if(node == 1){ + break() + } + parameters <- change_parameters_on_node(nodes,node,parameters) + } + parameters +} + + + + +parse_rule_row <- function(string){ + + rule_row <- regmatches(string,regexec("([a-zA-Z_0-9]+)([>=< ]+)(.*)",string,perl=TRUE))[[1]][-1] + if(rule_row[2] == ">="){ + rule_num <- 1 + } else { + rule_num <- 2 + } + rule <- list(c(rule_num,as.numeric(rule_row[3]))) + names(rule) <- rule_row[1] + return(rule) +} + +get_start_node <- function(frm){ + nfrm <- frm[frm$yval == 2,] + nfrm <- nfrm[nfrm[,"var"] == "",] + pot_start <- as.numeric(row.names(nfrm))[which.max(nfrm$n)] + pot_start +} + +get_parent_node <- function(node_id){ + as.integer(node_id/2) +} + +change_parameters_on_node <- function(nodes,node,parameters2){ + crule <- parse_rule_row(nodes[as.character(node)]) + minmax <- unlist(parameters2[parameters2[,1] == names(crule),c(3,4)]) + + if(crule[[1]][1] == 1){ + if(minmax[1]<=crule[[1]][2]){ + minmax[1] <- crule[[1]][2] + if(minmax[1] <= minmax[2]){ + parameters2[parameters2[,1] == names(crule),c(3,4)] <- minmax + } else { + write(sprintf("WARNING: %s's minimum(%s) > maximum(%s)", parameters2[,1], + minmax[1], minmax[2]), "errorlog.txt", append=TRUE) + } + } + } else { + if(minmax[2]>=crule[[1]][2]){ + minmax[2] <- crule[[1]][2] + if(minmax[1] <= minmax[2]){ + parameters2[parameters2[,1] == names(crule),c(3,4)] <- minmax + } else { + write(sprintf("WARNING: %s's minimum(%s) > maximum(%s)", parameters2[,1], + minmax[1], minmax[2]), "errorlog.txt", append=TRUE) + } + } + } + parameters2 +} + + diff --git a/docs/CIRM/statistics.R b/docs/CIRM/statistics.R new file mode 100644 index 0000000..ac2e518 --- /dev/null +++ b/docs/CIRM/statistics.R @@ -0,0 +1,76 @@ +library(RBBGCMuso) +file.copy("../../start_set/maize.epc","./start_set/maize.epc",overwrite=TRUE) +setwd("start_set/") + +rmse <- function(modelled, measured){ + sqrt(mean((modelled-measured)**2)) +} + +r2 <- function(modelled, measured){ + summary(lm("mod ~ meas", data= data.frame(mod=modelled,meas=measured)))$r.squared +} + +modeff <- function(modelled, measured){ + 1 - (sum((modelled-measured)**2) / sum((measured - mean(measured))**2)) +} + +bias <- function(modelled, measured){ + mean(modelled) - mean(measured) +} + +get_stats <- function(modelled,measured){ + c(r2=r2(modelled,measured), + rmse=rmse(modelled,measured), + bias=bias(modelled,measured), + modeff=modeff(modelled,measured)) +} + +get_modelled <- function(obsTable,settings, ...){ + simulation <- runMuso(settings, ...) + yield <- simulation[,"fruit_DM"] + modelled <- yield[match(as.Date(obsTable$date),as.Date(names(yield),"%d.%m.%Y"))] * 10 + modelled +} + +obsTable <- read.csv2("Martonvasar_maize.obs",stringsAsFactors=FALSE) +obsTable$mean <- obsTable$mean / 1000 * 0.85 +obsTable$sd <- obsTable$sd / 1000 +measured <- obsTable$mean + +# apriori +settings <- setupMuso(iniInput=c("n.ini","n.ini")) +modelled <- get_modelled(obsTable, settings) +results <- matrix(ncol=4,nrow=11) +colnames(results) <- c("r2","rmse","bias","modeff") +row.names(results) <- 0:10 +results[1,] <- get_stats(modelled,measured) +# max_likelihood_stats +for(i in 1:10){ + file.copy(sprintf("../%s/maize_ml.epc",i),"maize.epc",overwrite=TRUE) + settings <- setupMuso(iniInput=c("n.ini","n.ini")) + modelled <- get_modelled(obsTable, settings) + results[i+1,] <- get_stats(modelled, measured) +} +# median_stats +results_med <- results + +for(i in 1:10){ + file.copy(sprintf("../maize_median_step%02d_corrected.epc",i),"maize.epc",overwrite=TRUE) + settings <- setupMuso(iniInput=c("n.ini","n.ini")) + modelled <- get_modelled(obsTable, settings) + results_med[i+1,] <- get_stats(modelled, measured) +} +results_med + +succes_ratio <- numeric(10) +for(i in 1:10){ + succes_ratio[i] <- sum(read.csv(sprintf("../%s/result.csv",i),stringsAsFactors=FALSE)$Const[-1])/10000 +} +names(succes_ratio) <- 1:10 +png("../success_rate.png",height=30,width=30,res=300, units="cm") +barplot(succes_ratio,ylim=c(0,1),xlab="iteration number",ylab="Succes rate") +dev.off() + +postscript("../success_rate.eps") +barplot(succes_ratio,ylim=c(0,1),xlab="iteration number",ylab="Succes rate") +dev.off() diff --git a/docs/CIRM/tree_accuracy.R b/docs/CIRM/tree_accuracy.R new file mode 100644 index 0000000..f855572 --- /dev/null +++ b/docs/CIRM/tree_accuracy.R @@ -0,0 +1,70 @@ +library(rpart) +library(rpart.plot) + +accuracy <- function(x,rp){ + # Accuracy = (TP + TN)/(TP + TN + FP + FP) + # TP: True Positive + # TN: True Negative + # FP: False Positive + # FN: False Negative + + predicted <- rpart.predict(rp,type = "vector") + predicted[predicted==1] <- 0 + predicted[predicted==2] <- 1 + (sum(x*predicted) + sum((x + predicted) == 0)) / length(x) +} + +zero_var <- function(m){ + apply(m,2, function(v){ + var(v) != 0 + }) + +} + +decbin <- function(decnum){ + if(decnum < 2){ + return(decnum) + } + c(decbin((decnum %/% 2)),decnum %% 2) +} + +decpad <- function(decnum,len){ + binrep <- decbin(decnum) + c(rep(0,len-length(binrep)),binrep) +} + + +tree_per_const <- function(results="result.csv",output ="tree_per_const.pdf", + parameters_file="Martonvasar_maize.set"){ + varname <-readLines(parameters_file)[1] + parameters <- read.csv(parameters_file,skip=1,stringsAsFactors=FALSE) + + + results <- read.csv(results, stringsAsFactors=FALSE) + # likelihoods <- results[,ncol(results)-3] + # results <- results[likelihoods>=quantile(likelihoods,0.95),] + len <- round(log(max(results$failType),2)) + failTypes <- do.call(rbind,lapply(results$failType,function(x){decpad(x,len)})) + sapply(1:len, function(const){ + nonzero <- results[,1:(ncol(results)-4)] + nonzero <- nonzero[,-1] + nonzero <- nonzero[,zero_var(nonzero)] + colnames(nonzero) <- gsub("__.*","",colnames(nonzero)) + constraint <- failTypes[,const] + baseTable <- cbind.data.frame(nonzero,constraint = as.factor(constraint)) + tryCatch({ + rp <- rpart(constraint ~ .,data = baseTable) + accuracy(constraint, rp) + }, error = function(e){NA}) + }) +} + +results <- matrix(nrow=10,ncol=4) +row.names(results) <- 1:10 +colnames(results) <- c("Harvest Index", "LAI", "Root depth in phen. 5", "Flowering date") +for(i in 1:10){ + setwd(as.character(i)) + results[i,] <- tree_per_const(parameters_file="Martonvasar_maize_after_tree.set") + setwd("../") +} +results diff --git a/test.R b/test.R new file mode 100644 index 0000000..88e85f5 --- /dev/null +++ b/test.R @@ -0,0 +1,382 @@ +parameters <- +getOption("RMuso_constMatrix")[["epc"]][["6"]] + NAME + yearday to start new growth + yearday to end new growth + transfer growth period as fraction of growing season + litterfall as fraction of growing season + base temperature + minimum temperature for growth displayed on current day + optimal1 temperature for growth displayed on current day + optimal2 temperature for growth displayed on current day + maxmimum temperature for growth displayed on current day + minimum temperature for carbon assimilation displayed on current day + optimal1 temperature for carbon assimilation displayed on current day + optimal2 temperature for carbon assimilation displayed on current day + maxmimum temperature for carbon assimilation displayed on current day + annual leaf and fine root turnover fraction + annual live wood turnover fraction + annual fire mortality fraction + whole-plant mortality paramter for vegetation period + C:N of leaves + C:N of leaf litter + C:N of fine roots + C:N of fruit + C:N of softstem + C:N of live wood + C:N of dead wood + dry matter content of leaves + dry matter content of leaf litter + dry matter content of fine roots + dry matter content of fruit + dry matter content of softstem + dry matter content of live wood + dry matter content of dead wood + leaf litter labile proportion + leaf litter cellulose proportion + fine root labile proportion + fine root cellulose proportion + fruit labile proportion + fruit cellulose proportion + softstem labile proportion + softstem cellulose proportion + dead wood cellulose proportion + canopy water interception coefficient + canopy light extinction coefficient + potential radiation use efficiency + radiation parameter1 (Jiang et al.2015) + radiation parameter1 (Jiang et al.2015) + all-sided to projected leaf area ratio + ratio of shaded SLA:sunlit SLA + fraction of leaf N in Rubisco + fraction of leaf N in PeP + maximum stomatal conductance + cuticular conductance + boundary layer conductance + maximum height of plant + stem weight corresponding to maximum height + plant height function shape parameter (slope) + maximum depth of rooting zone + root distribution parameter + root weight corresponding to max root depth + root depth function shape parameter (slope) + root weight to rooth length conversion factor + growth resp per unit of C grown + maintenance respiration in kgC/day per kg of tissue N + theoretical maximum prop. of non-structural and structural carbohydrates + prop. of non-structural carbohydrates available for maintanance resp + symbiotic+asymbiotic fixation of N + time delay for temperature in photosynthesis acclimation + critical VWCratio (prop. to FC-WP) in germination + critical photoslow daylength + slope of relative photoslow development rate + critical vernalization temperature 1 + critical vernalization temperature 2 + critical vernalization temperature 3 + critical vernalization temperature 4 + slope of relative vernalization development rate + required vernalization days (in vernalization development rate) + critical flowering heat stress temperature 1 + critical flowering heat stress temperature 2 + theoretical maximum of flowering thermal stress mortality + VWC ratio to calc. soil moisture limit 1 (prop. to FC-WP) + VWC ratio to calc. soil moisture limit 2 (prop. to SAT-FC) + minimum of soil moisture limit2 multiplicator (full anoxic stress value) + vapor pressure deficit: start of conductance reduction + vapor pressure deficit: complete conductance reduction + maximum senescence mortality coefficient of aboveground plant material + maximum senescence mortality coefficient of belowground plant material + maximum senescence mortality coefficient of non-structured plant material + lower limit extreme high temperature effect on senescence mortality + upper limit extreme high temperature effect on senescence mortality + turnover rate of wilted standing biomass to litter + turnover rate of cut-down non-woody biomass to litter + turnover rate of cut-down woody biomass to litter + drought tolerance parameter (critical value of day since water stress) + effect of soilstress factor on photosynthesis + crit. amount of snow limiting photosyn. + limit1 (under:full constrained) of HEATSUM index + limit2 (above:unconstrained) of HEATSUM index + limit1 (under:full constrained) of TMIN index + limit2 (above:unconstrained) of TMIN index + limit1 (above:full constrained) of VPD index + limit2 (under:unconstrained) of VPD index + limit1 (under:full constrained) of DAYLENGTH index + limit2 (above:unconstrained) of DAYLENGTH index + moving average (to avoid the effects of extreme events) + GSI limit1 (greater that limit -> start of vegper) + GSI limit2 (less that limit -> end of vegper) + length of phenophase (GDD)-0 + leaf ALLOCATION -0 + fine root ALLOCATION-0 + fruit ALLOCATION -0 + soft stem ALLOCATION-0 + live woody stem ALLOCATION -0 + dead woody stem ALLOCATION -0 + live coarse root ALLOCATION-0 + dead coarse root ALLOCATION -0 + canopy average specific leaf area-0 + current growth proportion-0 + maximal lifetime of plant tissue-0 + length of phenophase (GDD)-1 + leaf ALLOCATION -1 + fine root ALLOCATION-1 + fruit ALLOCATION -1 + soft stem ALLOCATION-1 + live woody stem ALLOCATION -1 + dead woody stem ALLOCATION -1 + live coarse root ALLOCATION-1 + dead coarse root ALLOCATION -1 + canopy average specific leaf area-1 + current growth proportion-1 + maximal lifetime of plant tissue-1 + length of phenophase (GDD)-2 + leaf ALLOCATION -2 + fine root ALLOCATION-2 + fruit ALLOCATION -2 + soft stem ALLOCATION-2 + live woody stem ALLOCATION -2 + dead woody stem ALLOCATION -2 + live coarse root ALLOCATION-2 + dead coarse root ALLOCATION -2 + canopy average specific leaf area-2 + current growth proportion-2 + maximal lifetime of plant tissue-2 + length of phenophase (GDD)-3 + leaf ALLOCATION -3 + fine root ALLOCATION-3 + fruit ALLOCATION -3 + soft stem ALLOCATION-3 + live woody stem ALLOCATION -3 + dead woody stem ALLOCATION -3 + live coarse root ALLOCATION-3 + dead coarse root ALLOCATION -3 + canopy average specific leaf area-3 + current growth proportion-3 + maximal lifetime of plant tissue-3 + length of phenophase (GDD)-4 + leaf ALLOCATION -4 + fine root ALLOCATION-4 + fruit ALLOCATION -4 + soft stem ALLOCATION-4 + live woody stem ALLOCATION -4 + dead woody stem ALLOCATION -4 + live coarse root ALLOCATION-4 + dead coarse root ALLOCATION -4 + canopy average specific leaf area-4 + current growth proportion-4 + maximal lifetime of plant tissue-4 + length of phenophase (GDD)-5 + leaf ALLOCATION -5 + fine root ALLOCATION-5 + fruit ALLOCATION -5 + soft stem ALLOCATION-5 + live woody stem ALLOCATION -5 + dead woody stem ALLOCATION -5 + live coarse root ALLOCATION-5 + dead coarse root ALLOCATION -5 + canopy average specific leaf area-5 + current growth proportion-5 + maximal lifetime of plant tissue-5 + length of phenophase (GDD)-6 + leaf ALLOCATION -6 + fine root ALLOCATION-6 + fruit ALLOCATION -6 + soft stem ALLOCATION-6 + live woody stem ALLOCATION -6 + dead woody stem ALLOCATION -6 + live coarse root ALLOCATION-6 + dead coarse root ALLOCATION -6 + canopy average specific leaf area-6 + current growth proportion-6 + maximal lifetime of plant tissue-6 + INDEX UNIT DEPENDENCE MIN MAX GROUP TYPE + 9.00 yday NA 0.00000 364.0000 0 0 + 10.00 yday NA 0.00000 364.0000 0 0 + 11.00 prop NA 0.00000 1.0000 0 0 + 12.00 prop NA 0.00000 1.0000 0 0 + 13.00 Celsius NA 0.00000 12.0000 0 0 + 14.00 Celsius 0 0.00000 10.0000 1 1 + 15.00 Celsius 1 10.00000 20.0000 1 1 + 16.00 Celsius 2 20.00000 40.0000 1 1 + 17.00 Celsius 3 30.00000 50.0000 1 1 + 18.00 Celsius 0 0.00000 10.0000 2 1 + 19.00 Celsius 1 10.00000 20.0000 2 1 + 20.00 Celsius 2 20.00000 40.0000 2 1 + 21.00 Celsius 3 30.00000 50.0000 2 1 + 22.00 1/yr NA 0.10000 0.4000 0 0 + 23.00 1/yr NA 0.50000 1.0000 0 0 + 24.00 1/yr NA 0.00000 1.0000 0 0 + 25.00 1/vegper NA 0.00000 0.5000 0 0 + 26.00 kgC/kgN 0 10.00000 100.0000 3 1 + 27.00 kgC/kgN 1 10.00000 60.0000 3 1 + 28.00 kgC/kgN 1 10.00000 60.0000 3 1 + 29.00 kgC/kgN 1 10.00000 60.0000 3 1 + 30.00 kgC/kgN 1 10.00000 60.0000 3 1 + 31.00 kgC/kgN 0 50.00000 100.0000 4 1 + 32.00 kgC/kgN 1 300.00000 800.0000 4 1 + 33.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 34.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 35.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 36.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 37.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 38.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 39.00 kgC/kgDM NA 0.20000 0.6000 0 0 + 40.00 prop 1 0.10000 0.6000 5 2 + 41.00 prop 1 0.10000 0.6000 5 2 + 42.00 prop 1 0.10000 0.6000 6 2 + 43.00 prop 1 0.10000 0.6000 6 2 + 44.00 prop 1 0.10000 0.6000 7 2 + 45.00 prop 1 0.10000 0.6000 7 2 + 46.00 prop 1 0.10000 0.6000 8 2 + 47.00 prop 1 0.10000 0.6000 8 2 + 48.00 prop NA 0.50000 0.9000 0 0 + 49.00 1/LAI/d NA 0.01000 0.1000 0 0 + 50.00 dimless NA 0.20000 0.8000 0 0 + 51.00 g/MJ NA 2.00000 2.0000 0 0 + 52.00 dimless NA 0.78100 0.7810 0 0 + 53.00 dimless NA -13.59600 -13.5960 0 0 + 54.00 dimless NA 2.00000 2.0000 0 0 + 55.00 dimless NA 2.00000 2.0000 0 0 + 56.00 dimless NA 0.01000 0.2000 0 0 + 57.00 dimless NA 0.04240 0.0424 0 0 + 58.00 m/s NA 0.00100 0.1000 0 0 + 59.00 m/s NA 0.00001 0.0001 0 0 + 60.00 m/s NA 0.01000 0.0900 0 0 + 61.00 m NA 0.10000 10.0000 0 0 + 62.00 kgC NA 0.10000 100.0000 0 0 + 63.00 dimless NA 0.50000 0.5000 0 0 + 64.00 m NA 0.10000 10.0000 0 0 + 65.00 prop NA 3.67000 3.6700 0 0 + 66.00 kgC/m2 NA 0.40000 0.4000 0 0 + 67.00 prop NA 0.50000 0.5000 0 0 + 68.00 m/kg NA 1000.00000 1000.0000 0 0 + 69.00 prop NA 0.10000 0.5000 0 0 + 70.00 kgC/kgN/d NA 0.10000 0.5000 0 0 + 71.00 dimless NA 0.00000 1.0000 0 0 + 72.00 dimless NA 0.00000 1.0000 0 0 + 73.00 kgN/m2/yr NA 0.00000 0.0010 0 0 + 74.00 day NA 0.00000 50.0000 0 0 + 79.00 prop NA 0.00000 1.0000 0 0 + 81.00 hour NA 14.00000 18.0000 0 0 + 82.00 dimless NA 0.00500 0.0050 0 0 + 84.00 Celsius 0 -5.00000 5.0000 9 1 + 85.00 Celsius 1 0.00000 10.0000 9 1 + 86.00 Celsius 2 5.00000 15.0000 9 1 + 87.00 Celsius 3 10.00000 20.0000 9 1 + 88.00 dimless NA 0.04000 0.0400 0 0 + 89.00 dimless NA 30.00000 70.0000 0 0 + 91.00 Celsius 0 30.00000 40.0000 10 1 + 92.00 Celsius 1 30.00000 50.0000 10 1 + 93.00 prop NA 0.00000 0.4000 0 0 + 96.00 prop NA 0.50000 1.0000 0 0 + 97.00 prop NA 0.50000 1.0000 0 0 + 98.00 prop NA 0.00000 1.0000 0 0 + 99.00 Pa NA 500.00000 1500.0000 0 0 +100.00 Pa NA 1500.00000 3500.0000 0 0 +101.00 prop 0 0.00000 0.1000 0 0 +102.00 prop 1 0.00000 0.1000 0 0 +103.00 prop NA 0.00000 0.1000 0 0 +104.00 Celsius NA 30.00000 40.0000 0 0 +105.00 Celsius NA 30.00000 50.0000 0 0 +106.00 prop NA 0.00000 0.1000 0 0 +107.00 prop NA 0.00000 0.1000 0 0 +108.00 prop NA 0.00000 0.1000 0 0 +109.00 n_day NA 0.00000 100.0000 0 0 +110.00 dimless NA 0.00000 1.0000 0 0 +113.00 kg/m2 NA 0.00000 20.0000 0 0 +114.00 Celsius 0 0.00000 50.0000 11 1 +115.00 Celsius 1 0.00000 100.0000 11 1 +116.00 Celsius 0 -5.00000 5.0000 12 1 +117.00 Celsius 1 0.00000 10.0000 12 1 +118.00 Pa 0 2000.00000 600.0000 13 1 +119.00 Pa 1 500.00000 1500.0000 13 1 +120.00 s 0 0.00000 0.0000 14 1 +121.00 s 1 0.00000 0.0000 14 1 +122.00 n_day NA 2.00000 20.0000 0 0 +123.00 dimless NA 0.00000 0.2000 0 0 +124.00 dimless NA 0.00000 0.1000 0 0 +128.60 Celsius NA 0.00000 10000.0000 0 0 +129.60 prop 1 0.00000 1.0000 15 -3 +130.60 prop 1 0.00000 1.0000 15 -3 +131.60 prop 1 0.00000 1.0000 15 -3 +132.60 prop 1 0.00000 1.0000 15 -3 +133.60 prop 1 0.00000 1.0000 15 -3 +134.60 prop 1 0.00000 1.0000 15 -3 +135.60 prop 1 0.00000 1.0000 15 -3 +136.60 prop 1 0.00000 1.0000 15 -3 +137.60 m2/kg NA 0.00000 2.0000 0 0 +138.60 prop NA 0.00000 0.0000 0 0 +139.60 Celsius NA 1.00000 20000.0000 0 0 +128.61 Celsius NA 0.00000 10000.0000 0 0 +129.61 prop 1 0.00000 1.0000 16 -3 +130.61 prop 1 0.00000 1.0000 16 -3 +131.61 prop 1 0.00000 1.0000 16 -3 +132.61 prop 1 0.00000 1.0000 16 -3 +133.61 prop 1 0.00000 1.0000 16 -3 +134.61 prop 1 0.00000 1.0000 16 -3 +135.61 prop 1 0.00000 1.0000 16 -3 +136.61 prop 1 0.00000 1.0000 16 -3 +137.61 m2/kg NA 0.00000 2.0000 0 0 +138.61 prop NA 0.00000 0.0000 0 0 +139.61 Celsius NA 1.00000 20000.0000 0 0 +128.62 Celsius NA 0.00000 10000.0000 0 0 +129.62 prop 1 0.00000 1.0000 17 -3 +130.62 prop 1 0.00000 1.0000 17 -3 +131.62 prop 1 0.00000 1.0000 17 -3 +132.62 prop 1 0.00000 1.0000 17 -3 +133.62 prop 1 0.00000 1.0000 17 -3 +134.62 prop 1 0.00000 1.0000 17 -3 +135.62 prop 1 0.00000 1.0000 17 -3 +136.62 prop 1 0.00000 1.0000 17 -3 +137.62 m2/kg NA 0.00000 2.0000 0 0 +138.62 prop NA 0.00000 0.0000 0 0 +139.62 Celsius NA 1.00000 20000.0000 0 0 +128.63 Celsius NA 0.00000 10000.0000 0 0 +129.63 prop 1 0.00000 1.0000 18 -3 +130.63 prop 1 0.00000 1.0000 18 -3 +131.63 prop 1 0.00000 1.0000 18 -3 +132.63 prop 1 0.00000 1.0000 18 -3 +133.63 prop 1 0.00000 1.0000 18 -3 +134.63 prop 1 0.00000 1.0000 18 -3 +135.63 prop 1 0.00000 1.0000 18 -3 +136.63 prop 1 0.00000 1.0000 18 -3 +137.63 m2/kg NA 0.00000 2.0000 0 0 +138.63 prop NA 0.00000 0.0000 0 0 +139.63 Celsius NA 1.00000 20000.0000 0 0 +128.64 Celsius NA 0.00000 10000.0000 0 0 +129.64 prop 1 0.00000 1.0000 19 -3 +130.64 prop 1 0.00000 1.0000 19 -3 +131.64 prop 1 0.00000 1.0000 19 -3 +132.64 prop 1 0.00000 1.0000 19 -3 +133.64 prop 1 0.00000 1.0000 19 -3 +134.64 prop 1 0.00000 1.0000 19 -3 +135.64 prop 1 0.00000 1.0000 19 -3 +136.64 prop 1 0.00000 1.0000 19 -3 +137.64 m2/kg NA 0.00000 2.0000 0 0 +138.64 prop NA 0.00000 0.0000 0 0 +139.64 Celsius NA 1.00000 20000.0000 0 0 +128.65 Celsius NA 0.00000 10000.0000 0 0 +129.65 prop 1 0.00000 1.0000 20 -3 +130.65 prop 1 0.00000 1.0000 20 -3 +131.65 prop 1 0.00000 1.0000 20 -3 +132.65 prop 1 0.00000 1.0000 20 -3 +133.65 prop 1 0.00000 1.0000 20 -3 +134.65 prop 1 0.00000 1.0000 20 -3 +135.65 prop 1 0.00000 1.0000 20 -3 +136.65 prop 1 0.00000 1.0000 20 -3 +137.65 m2/kg NA 0.00000 2.0000 0 0 +138.65 prop NA 0.00000 0.0000 0 0 +139.65 Celsius NA 1.00000 20000.0000 0 0 +128.66 Celsius NA 0.00000 10000.0000 0 0 +129.66 prop 1 0.00000 1.0000 21 -3 +130.66 prop 1 0.00000 1.0000 21 -3 +131.66 prop 1 0.00000 1.0000 21 -3 +132.66 prop 1 0.00000 1.0000 21 -3 +133.66 prop 1 0.00000 1.0000 21 -3 +134.66 prop 1 0.00000 1.0000 21 -3 +135.66 prop 1 0.00000 1.0000 21 -3 +136.66 prop 1 0.00000 1.0000 21 -3 +137.66 m2/kg NA 0.00000 2.0000 0 0 +138.66 prop NA 0.00000 0.0000 0 0 +139.66 Celsius NA 1.00000 20000.0000 0 0