Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
!*****************************************************************!
!* *!
!* 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