!*****************************************************************!
!* *!
!* ForeSee Simulation Model *!
!* *!
!* *!
!* Declaration of species and cohort variables *!
!* data_stand *!
!* Subroutines: *!
!* del_cohort *!
!* test_cohort *!
!* list_cohort *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
MODULE data_stand
INTEGER :: anz_coh = 0 ! current amount of cohortes
INTEGER :: max_coh = 0 ! max. amount of cohortes
REAL :: kpatchsize = 200 ! patch size [m^2]
REAL :: dz = 50 ! thickness of a crown layer [cm]
INTEGER :: waldtyp ! forest type
! variables for the whole stand
INTEGER,allocatable,save,dimension(:):: nrspec ! actual kind numbers of species
REAL,dimension(0:300) :: Irelpool ! relative light intensitiy of the crown space which is not
! occupied by trees (pool). This is the light intensitiy
! at the top of each layer. Irelpool(0)=light unto ground
REAL,dimension(1:301) :: BGpool ! fraction of patch covered by 'free crown space' for
! the next layer respectivley.
REAL,dimension(0:300) :: precpool ! relative precipitation intensitiy of the crown space which is not
! occupied by trees (pool). This is the precipitation intensitiy
! at the top of each layer
REAL :: Irelpool_ll ! relative light intensitiy at the lowest layer
REAL :: bgpool_ll ! fraction of patch covered by 'free crown space'
REAL :: totFPARsum ! fraction of absorbed light for the whole patch
REAL :: totFPARcan ! fraction of absorbed light for the whole canopy
REAL :: LAI ! leaf area index of the patch [m^2/m^2]
REAL :: LAI_can ! leaf area index of the canopy [m^2/m^2]
REAL :: LAI_sveg ! leaf area index of the ground vegetation [m^2/m^2]
REAL :: LAImax ! leaf area index of the patch in period when all trees carry leaves [m^2/m^2]
REAL :: LAI_in ! leaf area index of new trees [m^2/m^2]
REAL :: LAI_out ! leaf area index of removed trees [m^2/m^2]
REAL :: crown_area ! projected crown area [m**2] for the whole canopy,
REAL :: gp_tot ! unstressed stomatal conductance of the total vegetation (canopy + ground vegetation) [mol/(m2*d)]
REAL :: gp_can ! unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: gp_can_mean ! yearly mean of unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: gp_can_min ! yearly minimum of unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: gp_can_max ! yearly maximum of unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: drIndd ! daily drought index for the whole stand [-], weighted by ntree
REAL :: drIndAl ! drought index for allocation calculation (cum.) for the whole stand [-],
! weighted by NPP
REAL :: mean_drIndAl ! mean drought index for allocation calculation (cum.) for the whole stand [-],
REAL :: RedN_mean ! mean RedN of all species
INTEGER :: anz_RedN ! number of RedN for calculation of RedN_mean
REAL :: sumbio ! biomass of all cohorts and all tree-species [kg DW/ha]
REAL :: sumbio_sv ! biomass of all cohorts and all ground-vegetation-species [kg DW/ha]
REAL :: sumbio_in ! biomass of new trees [kg DW/ha]
REAL :: sumbio_out ! biomass of removed trees [kg DW/ha]
REAL :: cumsteminc ! total cumulated sum of all stem increments [kg/ha]
REAL :: cumsumvsab ! cumulated total sum of volume of removed stems by management [kg/ha]
REAL :: cumsumvsdead ! cumulated total sum of volume of dead stems [kg/ha]
REAL :: sumvsab ! total sum of volume of removed stems by management [kg/ha]
REAL :: sumvsab_m3 ! total sum of volume of removed stems by management [m�/ha]
REAL :: sumvsdead ! total sum of volume of dead stems [kg/ha]
REAL :: sumvsdead_m3 ! total sum of volume of dead stems [m�/ha]
REAL :: totfol ! total biomass of foliage [kg DW/ha]
REAL :: totfol_in ! total biomass of foliage of new trees [kg DW/ha]
REAL :: totfol_out ! total biomass of foliage of removed trees [kg DW/ha]
REAL :: totsap ! total biomass of sapwood [kg DW/ha]
REAL :: totfrt ! total fine root biomass of all cohorts and all species [kg DW/ha]
REAL :: totfrt_p ! total fine root biomass of all cohorts and all species per patch [kg DW/patchsize]
REAL :: totfrt_1 ! reciprocal of total fine root biomass of all cohorts and all species per patch [kg DW/patchsize]
REAL :: tottb ! total twigs, branches biomass of all cohorts and all species [kg DW/ha]
REAL :: totcrt ! total coarse root biomass of all cohorts and all species [kg DW/ha]
REAL :: seedlfrt ! total fine root biomass of all cohorts with height < thr_height [kg DW]
REAL :: tothrt ! total biomass of heartwood [kg DW/ha]
REAL :: sumNPP ! total NPP of all cohorts and species
REAL :: cum_sumNPP ! cumulative total NPP of all cohorts and species
REAL :: sumGPP ! total GPP of all cohorts and species [g C/m2 --> t C/ha]
REAL :: totfol_lit ! total foliage litter [kg DW / ha / year]
REAL :: totfol_lit_tree ! total foliage litter of trees [kg DW / ha / year]
REAL :: totfrt_lit ! total fine root litter [kg DW / ha / year]
REAL :: totfrt_lit_tree ! total fine root litter of trees [kg DW / ha / year]
REAL :: tottb_lit ! total litter of twigs, and branches [kg DW / ha / year]
REAL :: totcrt_lit ! total litter of coarse roots [kg DW / ha / year]
REAL :: totstem_lit ! total dead biomass of stems [kg DW / ha / year]
REAL :: totsteminc ! total stem increment of patch [kg DW/ha]
REAL :: totsteminc_m3 ! total stem increment of patch in m3
REAL :: totstem_m3 ! total stem volume [m3/ha]
REAL :: Ndem ! total N demand of the stand per year [g/m2]
REAL :: autresp ! total autotroph resp of all cohorts and species
REAL :: autresp_m ! mean total autotroph resp of all cohorts and species (mean over all years)
REAL :: sumTER ! total ecosystem respiration of all cohorts and species [g C/m2 --> t C/ha]
INTEGER :: coh_ident_max ! actual maximum ident number of cohorts
INTEGER :: anz_coh_in ! number of new cohorts
INTEGER :: anz_coh_out ! number of removed cohorts
INTEGER :: anz_coh_act ! number of cohorts of the actual year
INTEGER :: anz_spec ! number of current existing tree species
INTEGER :: anrspec ! number of all current existing species
INTEGER :: anz_spec_in ! number of new tree species
INTEGER :: anz_spec_out ! number of removed tree species
INTEGER :: anz_tree_dbh ! number of trees with dbh
INTEGER :: anz_tree ! total number of trees /patch
INTEGER :: anz_tree_ha ! total number of trees /ha
INTEGER :: anz_tree_in ! number of new trees /ha
INTEGER :: anz_tree_out ! number of removed trees /ha
INTEGER :: anz_sveg ! total number of soil vegetation cohorts
REAL :: med_diam ! medium diameter of stand (Dg)
REAL :: med_diam_in ! medium diameter of new trees (Dg)
REAL :: med_diam_out ! medium diameter of removed trees (Dg)
REAL :: hdom ! medium height of 2 dominant trees
REAL :: hmean_in ! mean height of all new trees
REAL :: hmean_out ! mean height of all removed trees
REAL :: mean_height ! mean height of stand [cm]
REAL :: mean_diam ! mean diameter of stand [cm]
REAL :: basal_area ! basal area [m�]
INTEGER :: highest_layer ! highest foliage layer of the stand
INTEGER :: lowest_layer ! lowest foliage layer of the stand.
! lowest_layer=0: bare ground
INTEGER :: lm3layer ! light model 4: layer from that on light model 3 is used
REAL :: GRASS_day
REAL :: NETASS_day
REAL :: GPP_day ! daily GPP of all cohorts and species after scaling by temperature
REAL, dimension(12) :: GPP_mon ! monthly GPP of all cohorts and species
REAL, dimension(53) :: GPP_week ! weekly GPP of all cohorts and species
REAL :: GPP_dec ! sum of GPP of all cohorts and species of last december
REAL, dimension(12) :: NEE_mon ! monthly NEE of all cohorts and species
REAL :: NEE_dec ! sum of NEE of all cohorts and species of last december
REAL :: NPP_day ! daily NPP of all cohorts and species after scaling by temperature
REAL, dimension(12) :: NPP_mon ! monthly NPP of all cohorts and species
REAL, dimension(53) :: NPP_week ! weekly NPP of all cohorts and species
REAL :: NPP_dec ! sum of NPP of all cohorts and species of last december
REAL :: TER_day ! daily TER of all cohorts and species after scaling by temperature
REAL, dimension(12) :: TER_mon ! monthly total ecosystem respiration of all cohorts and species
REAL, dimension(53) :: TER_week ! weekly total ecosystem respiration of all cohorts and species
REAL :: TER_dec ! sum of TER of all cohorts and species of last december
REAL :: respr_day ! daily root respiration of all cohorts and species after scaling by temperature
REAL, dimension(12) :: respr_mon ! monthly total root respiration of all cohorts and species (fine and coarse roots)
REAL, dimension(53) :: respr_week ! weekly total root respiration of all cohorts and species
REAL,allocatable, save, dimension(:) :: dayfract ! daily fraction of fluxes (depending on temperature)
REAL :: dailyNPP_C, & ! daily net production [gC/m2]
dailypotNPP_C, & ! daily potential (= no water and nutrient limitation) net primary production [gC/m2]
dailyautresp_C, & ! daily autotrophic respiration [gC/m2]
dailygrass_C, & ! daily gross assimilation [gC/m2]
dailynetass_C, & ! daily net assimilation [gC/m2]
dailyrespfol_C, & ! daily maintenance leaf respiration [gC/m2]
phot_C, & ! daily gross photosynthesis [gC/m2]
precsum
REAL :: ceppot_can ! pot. intercept. whole canopy
REAL :: ceppot_sveg ! pot. intercept. whole ground vegetation
INTEGER :: phen_flag=0 ! phenology flag, =1 if canopy changes due to
! phenological events
REAL :: basal_area_tot ! basal area of the whole stand [cm�]
! variables used in sum-output
REAL :: photsum,nppsum, &
npppotsum,resosum, &
lightsum, &
abslightsum,nee, &
gppsum, &
tersum, & ! total ecosystem respiration
resautsum, & ! autotrophe respiratiom
aet_sum, pet_sum, &
tempmean, tempmeanh !summation variable for output *_sum
! variables for representation index calculation
REAL :: rindex1, &
rindex2
! variable for ground-vegetation
REAL :: M_avail ! mass available for allocation to organs in soil veg. initialisation [kg DM m-2]
REAL :: NPP_est ! NPP estimated for soil veg. initialisation [g DM m-2]
! Variables for disturbances
REAL :: phlo_feed ! Percentage loss of carbon due to phloem feeders
REAL :: stem_rot ! Percentage loss of stems due to stem rot
! variables for classification of trees
INTEGER :: num_class=29 ! number of diameter and height classes
INTEGER,allocatable, save, dimension(:,:) :: diam_class, diam_classm, diam_class_t, diam_class_age
REAL ,allocatable, save, dimension(:,:) :: diam_class_h, diam_classm_h, diam_class_mvol
INTEGER,allocatable, save, dimension(:) :: height_class
! ! variables per species
INTEGER,allocatable,save,dimension(:) :: height_rank ! number of trees per species
INTEGER,allocatable,save,dimension(:) :: dbh_rank ! number of trees per species
type species_var
! variables per species
INTEGER :: daybb ! day of bud burst per species [julian day of year]
INTEGER :: ext_daybb ! externally prescribed day of bud burst per species [julian day of year]
INTEGER :: sum_nTreeA ! number of trees per species [per ha]
INTEGER :: sum_nTreeD ! number of all dead trees per species [per ha]
INTEGER :: anz_coh ! number of cohorts per species
REAL :: RedN ! photosynthesis nitrogen reduction factor [-]
REAL :: RedNm ! mean annual photosynthesis nitrogen reduction factor [-]
REAL :: med_diam ! medium diameter per species (squared average) [cm]
REAL :: mean_diam ! average diameter per species [cm]
REAL :: mean_jrb ! average year ring width [mm]
REAL :: dom_height ! dominant height per species [cm]
REAL :: mean_height ! average height per species [cm]
REAL :: basal_area ! basal area per species [m�]
REAL :: drIndAl ! drought index for allocation calculation (cum.) per species [-]
! weighted by NPP
REAL :: sumNPP ! total NPP of all cohorts per species
REAL :: sum_bio ! total biomass per species [kg DW/ha]
REAL :: sum_lai ! maximum annual LAI per species
REAL :: act_sum_lai ! LAI per species
REAL :: fol ! total foliage mass per species [kg DW/ha]
REAL :: hrt ! total heartwood mass per species [kg DW/ha]
REAL :: sap ! totalsapwood mass per species [kg DW/ha]
REAL :: frt ! total fine root mass per species [kg DW/ha]
REAL :: totsteminc ! total stem increment per species [kg DW/ha]
REAL :: totsteminc_m3 ! total stem increment per species [m3/ha]
REAL :: totstem_m3 ! total stem volume per species [m�/ha]
REAL :: sumvsab ! total sum of volume of harvested stem mass of species [kg/ha]
REAL :: sumvsdead ! total sum of volume of dead stems [kg/ha]
REAL :: sumvsdead_m3 ! total sum of volume of dead stems [m3/ha]
REAL :: crown_area ! species specific crown area
REAL :: Ndem ! total N demand per species and year [g/m2]
REAL :: Nupt ! total N uptake per species and year [g/m2]
REAL :: Ndemp ! total N demand per species and potosynthesis period [g/m2]
REAL :: Nuptp ! total N uptake per species and potosynthesis period [g/m2]
! Phenology parameters
REAL :: Pro ! Depending on phenomodel: Promotor or Temperature sum
REAL :: Inh ! Depending on phenomodel: Inhibitor or chill days
REAL :: Tcrit ! Critical temperature sum for Cannel-Smith model [�C]
REAL,pointer,dimension(:) :: BDmax ! species specific maximum bulk density for root growth in soil layers
REAL,pointer,dimension(:) :: tstress ! species specific temperature stress for root growth in soil layers
REAL,pointer,dimension(:) :: sstr ! species specific soil strength stress for root growth in soil layers
REAL,pointer,dimension(:) :: BDstr ! species specific bulk density stress for root growth in soil layers
REAL,pointer,dimension(:) :: porcrit ! species specific critical pore space for root growth in soil layers
REAL,pointer,dimension(:) :: airstr ! species specific aeration stress for root growth in soil layers
REAL,pointer,dimension(:) :: phstr ! species specific pH stress for root growth in soil layers
REAL,pointer,dimension(:) :: Rstress ! species specific total daily stress for root growth in soil layers
REAL,pointer,dimension(:) :: Smean ! species specific total yearly stress for root growth in soil layers
end type species_var
type(species_var),allocatable,dimension(:),target :: svar
type cohort
INTEGER :: ident ! identification of cohort
INTEGER :: species ! number of species parameter set in spar (type)
! state variables for population dynamics
REAL :: nTreeA ! number of alive trees (output) integer [-]
REAL :: nTreeD ! number of dead trees integer [-]
REAL :: nTreeM ! number of trees harvested by Management
REAL :: nTreet ! number of trees tended by Management
REAL :: nta ! number of alive trees (internal) REAL [-]
INTEGER :: mistletoe ! cohort has / has no mistletoe infection
! all variables are values of single trees !!!
! tree state variables; DW = dry weight (i.e., dry biomass)
INTEGER :: x_age ! tree age [yr]
REAL :: x_fol ! foliage biomass [kg DW / tree]
REAL :: x_fol_loss ! loss of foliage biomass [kg DW / tree] by disturbance (flag_dis=1)
REAL :: x_sap ! sapwood biomass [kg DW / tree]
REAL :: x_frt ! fine root biomass [kg DW / tree]
REAL :: x_frt_loss ! loss of fine root biomass [kg DW / tree] by disturbance (flag_dis=1)
REAL :: x_hrt ! heartwood biomass [kg DW / tree]
REAL :: x_rdpt ! rooting depth [cm]
REAL :: x_crt ! coarse root biomass [kg DW / tree]
REAL :: x_tb ! twigs and branches biomass [kg DW / tree]
REAL :: x_hsap ! sapwood height [cm]
REAL :: x_hbole ! bole height [cm]
REAL :: x_Ahb ! cross sectional area of heart wood at stem base [cm**2]
INTEGER :: x_stress ! number of stress years [-]
INTEGER :: x_health ! number of years without stress [-]
REAL :: x_nsc_sap ! sapwood nsc-pool [kg C / tree]
REAL :: x_nsc_tb ! twigs and branch nsc-pool [kg C / tree]
REAL :: x_nsc_crt ! coarse root nsc-pool [kg C / tree]
REAL :: x_nsc_sap_max !maximum amount sapwood nsc-pool [kg C / tree]
REAL :: x_nsc_tb_max !maximum amount twigs and branch nsc-pool [kg C / tree]
REAL :: x_nsc_crt_max !maximum amount coarse root nsc-pool [kg C / tree]
REAL :: biocost_all !biosynthesis costs for refilling process [kg DW / tree]
! auxiliary variables
REAL :: bes ! avarage beset or press of cohort
REAL :: med_sla ! average cohort specific leaf area [m�/kg]
REAL :: Fmax ! maximum foliage biomass [kg DW]
REAL :: totBio ! total tree biomass [kg DW]
REAL :: Dbio ! total dead biomass per cohort [kg DW]
REAL :: height ! total tree height [cm]
REAL :: deltaB ! change in bole height [cm]
REAL :: Ahc ! cross sectional area of heart wood at crown base [cm**2]
REAL :: dcrb ! trunc diameter at crown base [cm]
REAL :: diam ! diameter at breast height [cm]
real :: jrb ! year ring width [mm]
REAL :: assi ! optimum gross assimilation rate [kg DW/d/patch] !!! not a tree variable
REAL :: LUE ! light use efficiency [gC/micromole]
REAL :: resp ! leaf respiration rate [kg DW/d/patch] !!! not a tree variable
REAL :: netAss ! realized net assimilation rate [kg DW/d]
REAL :: NPP ! NPP [kg DW/yr]
REAL :: weekNPP ! weekly NPP [kg DW/yr]
REAL :: NPPpool
REAL :: t_leaf ! leaf area per tree [m2]
REAL :: geff ! growth efficiency [kg stem DM/(yr*m2)]
REAL :: Asapw ! tree sapwood cross sectional area in bole space [cm2]
REAL :: crown_area ! projected crown area [m**2],
! is the same in each layer; maximal proj. crown area,
! when enough space available crown_area
REAL,dimension(301) :: BG ! fraction of the patch covered by the
! tree in each layer, may change through the layers.
REAL,dimension(0:300) :: leafArea ! leaf area per layer [m2]
REAL,dimension(0:300) :: sleafArea ! leaf area per layer [m2], stocked
REAL,dimension(0:300) :: FPAR ! light version 1-3 : fraction of PAR
! absorbed by each layer per crown coverage area [-]
! light version 4 : fraction of PAR absorbed until(!)
! each layer per patch [-]
REAL,dimension(0:300) :: antFPAR ! fraction of totFPAR per crown layer
REAL,dimension(0:300) :: Irel ! relative incident radiation
! intensitiy at the top of a given layer
REAL :: totFPAR ! total fraction of PAR absorbed [-],
! per m� patch area!
REAL :: IrelCan ! the relative light regime in the
! middle of the cohort's canopy
INTEGER :: botLayer ! number of bottom layer of crown [-]
INTEGER :: topLayer ! number of top layer of crown [-]
REAL :: survp ! survival probability first 5 years of simulation
REAL :: rel_fol ! relative part foliage of cohort
REAL :: gfol ! gross growth rate foliage
REAL :: gfrt ! gross growth rate fine root
REAL :: gsap ! gross growth rate sap wood
REAL :: sfol ! senescence rate foliage
REAL :: sfrt ! senescence rate fine root
REAL :: ssap ! senescence rate sap wood
REAL :: grossass ! gross assimilation rate [kg DW/yr]
REAL :: maintres ! cumulative maintenance respiration (sap + frt) [kg DW/yr]
REAL :: respsap ! daily respiration rate sapwood [kg DW/d]
REAL :: respfrt ! daily respiration rate fine root [kg DW/d]
REAL :: respfol ! maintenance daily leaf respiration [kg DW/d]
REAL :: respbr ! daily respiration rate branches, c. roots .... [kg DW/d]
REAL :: respaut ! daily autotrophic respiration rate of tree .... [kg DW/d]
REAL :: resphet ! daily hetrotrophic respiration rate of tree .... [kg DW/d]
!
! aux. variables for calculation of crown_area of new established trees
REAL :: height_ini ! initial value of height of a new established tree cohort by ingrowth [cm]
REAL :: ca_ini ! initial value of crown area of a new established tree cohort by ingrowth [m2]
! new aux. variables for mAustrian management by relative diamter class
INTEGER :: rel_dbh_cl ! relative DBH class
INTEGER :: underst ! 0 = overstorey, 1 = seedling cohort, 2 = understorey
INTEGER :: sprout ! 0 = tree is no sprout, 1 = sprout
INTEGER :: fl_sap ! sapling = 0, tree = 1
! growth-mortality coupling variables
REAL :: fol_inc ! foliage increment [kg DW/yr]
REAL :: fol_inc_old ! foliage increment of last year[kg DW/yr]
REAL :: bio_inc ! net biomass increment [kg DW/yr]
REAL :: stem_inc ! stem wood increment [kg DW/yr]
REAL :: frt_inc ! fine root wood increment [kg DW/yr]
logical :: notViable ! .TRUE. if non-biological tree dimensions occur
integer :: flag_vegend=0
! plant-soil water coupling variables
REAL,dimension(0:300):: intcap ! precipitation absorbed by
! each layer per m� patch area [mm]
REAL,dimension(0:300):: prel ! precipitation
! at the top of a given layer [mm] per m� patch area
REAL :: interc ! total intercepted precipitation [mm],
! per m� patch area!
REAL :: prelCan ! the relative precipitaion regime
! in the middle of the cohort's canopy
REAL :: interc_st ! interception storage [mm/m2]
REAL :: aev_i ! actual evaporation of intercepted water [mm]
REAL :: demand ! daily demand for soil water of cohort [mm/day]
REAL :: supply ! daily uptake of soil water by roots of cohort [mm/day]
REAL :: watuptc ! yearly total uptake of soil water by roots [mm/day]
REAL :: watleft ! yearly total water left in soil layer next to last rooted soil layer [mm]
REAL :: gp ! unstressed stomatal conductance [mol/(m2*d)]
REAL :: drIndd ! daily drought index [-]
REAL :: drIndPS ! drought index for photosynthesis calculation (cum.) [-]
REAL :: nDaysPS ! number of growing season days per time step of PS model [-]
REAL :: drIndAl ! drought index for allocation calculation (cum.) [-]
INTEGER :: nDaysGr ! number of growing season days per year [#]
logical :: isGrSDay ! is the current day a growing season day?
! plant-soil C/N coupling variables in kg per cohort
REAL :: litC_fol ! foliage litter C pool [kg/cohort]
REAL :: litC_fold ! foliage litter C pool [kg/cohort] of dead trees
REAL :: litN_fol ! foliage litter N pool [kg/cohort]
REAL :: litN_fold ! foliage litter N pool [kg/cohort] of dead trees
REAL :: litC_frt ! fine root litter C pool [kg/cohort]
REAL :: litC_frtd ! fine root litter C pool [kg/cohort] of dead trees
REAL :: litN_frt ! fine root litter N pool [kg/cohort]
REAL :: litN_frtd ! fine root litter N pool [kg/cohort] of dead trees
REAL :: litC_stem ! stemwood litter C pool [kg/cohort]
REAL :: litN_stem ! stemwood litter N pool [kg/cohort]
REAL :: litC_tb ! twig, and branch litter C pool [kg/cohort]
REAL :: litC_crt ! coarse root litter C pool [kg/cohort]
REAL :: litC_tbcd ! twigs, branches, and coarse root litter C pool [kg/cohort] of dead trees
REAL :: litN_tb ! twig, and branch litter N pool [kg/cohort]
REAL :: litN_crt ! coarse root litter N pool [kg/cohort]
REAL :: litN_tbcd ! twigs, branches, and coarse root litter N pool [kg/cohort] of dead trees
REAL :: Nuptc_c ! N uptake per tree and year [g/yr]
REAL :: Ndemc_c ! N demand per tree and year [g/yr]
REAL :: Nuptc_d ! daily N uptake per tree [g/d]
REAL :: Ndemc_d ! daily N demand per tree [g/d]
REAL :: RedNc ! tree specific RedN (photosynthesis nitrogen reduction factor) [-]
REAL :: N_pool ! N pool per tree [g]
REAL :: N_fol ! N content of foliage per tree [g]
REAL :: wat_mg ! cohort water uptake (flag_wred=9)
! root distribution
REAL,pointer,dimension(:) :: frtrel ! relative part of fine root mass of tree per soil layer
REAL,pointer,dimension(:) :: frtrelc ! relative part of fine root mass of cohort of total layer fine root mass per soil layer
REAL,pointer,dimension(:) :: rld ! root length [cm per cm3]
REAL,pointer,dimension(:) :: rooteff ! root uptake efficiency per soil layer
INTEGER :: nroot ! nroot soil layer with max. root depth
! pseudo parameter (used as an index for field spar with species-specific parameters)
INTEGER :: shelter ! �berhaelter
! Phenology parameters
INTEGER :: day_bb ! day_bb day of bud burst [julian day of year]
! day_bb
REAL :: P ! Depending on phenomodel: Promotor or Temperature sum
REAL :: I ! Depending on phenomodel: Inhibitor or chill days
REAL :: Tcrit ! Critical temperature sum for Cannel-Smith model [�C]
end type cohort
type coh_obj
type(cohort) :: coh ! cohort data structure
type(coh_obj), pointer :: next ! pointer to next cohort
end type coh_obj
type coh_list
type(coh_obj), pointer :: first ! List of cohorts
end type coh_list
type(coh_list) :: pt ! variable for whole stand, all cohorts
type(cohort), pointer, dimension(:) :: coh_save ! pointer to variables for saving intialisation of all cohorts
type(coh_obj), pointer :: zeig ! pointer variable for manipulating cohorts
INTEGER :: anz_coh_save
type vert_struct
REAL :: LA ! leaf area in a given layer [m�]
REAL :: cumLAI ! cumulative leaf area index at the bottom of a given layer [m�/m�]
REAL :: radFrac ! fraction of total radiation absorbed in a given layer [-]
REAL :: sumBG ! sum of all crown areas in a layer [m�]
REAL :: Irel ! light version 1,2 : relative incident radiation at the top of a given layer [-]
! light version 3,4 : average relative incident radiation at the bottom of a given layer [-]. For test reasons only
end type vert_struct
type(vert_struct),dimension(0:300) :: vStruct ! field with vertical patch structure
! variables for litter retention
type dead_litter
INTEGER :: specnr ! species number
! arrays of dead stem and twigs/branches
REAL,pointer,dimension(:) :: C_tb
REAL,pointer,dimension(:) :: N_tb
REAL,pointer,dimension(:) :: C_stem
REAL,pointer,dimension(:) :: N_stem
end type dead_litter
INTEGER :: lit_year = 5 ! number of years of retention
type(dead_litter),allocatable,dimension(:),target :: dead_wood ! delay over 5 years []
!----------------------------------------------------------------------------------------
contains
function neu() result (stand_neu) ! Create a new pointer list = new stand without any cohort
implicit none
type(coh_list) :: stand_neu
nullify(stand_neu%first)
end function neu
!----------------------------------------------------------------------------------------
subroutine del_cohort
use data_species
use data_simul
implicit none
type(coh_obj), pointer :: nachlauf
zeig => pt%first
do while (associated(zeig))
if (zeig%coh%nTreeA < 0.1.or. (zeig%coh%species.gt.nspec_tree.and.zeig%coh%x_fol.le. 1.E-6)) then
pt%first => zeig%next
deallocate(zeig%coh%frtrel)
deallocate(zeig%coh%frtrelc)
deallocate(zeig%coh%rooteff)
if (flag_wred .eq. 9) deallocate(zeig%coh%rld)
deallocate(zeig)
zeig => pt%first
anz_coh=anz_coh-1
else
nachlauf => zeig
zeig => zeig%next
exit
end if
end do
do while (associated(zeig))
if (zeig%coh%nTreeA < 0.1.or. (zeig%coh%species.gt.nspec_tree.and.zeig%coh%x_fol.le. 1.E-6)) then
nachlauf%next => zeig%next
deallocate(zeig%coh%frtrel)
deallocate(zeig%coh%frtrelc)
deallocate(zeig%coh%rooteff)
if (flag_wred .eq. 9) deallocate(zeig%coh%rld)
deallocate(zeig)
zeig => nachlauf%next
anz_coh=anz_coh-1
else
nachlauf => zeig
zeig => zeig%next
end if
end do
end subroutine del_cohort
!----------------------------------------------------------------------------------------
subroutine list_cohort ! Output of cohort list
implicit none
INTEGER :: i
zeig => pt%first
i = 0
do while (associated(zeig))
i = i + 1
zeig => zeig%next
end do
end subroutine list_cohort
!----------------------------------------------------------------------------------------
subroutine test_cohort(ts)
implicit none
INTEGER, intent(out):: ts
zeig => pt%first
if (.not. associated(zeig)) then
print *,' No existing cohort!'
ts = 1
else
ts = 0
end if
end subroutine test_cohort
end module data_stand