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
!*****************************************************************!
!* *!
!* 4C (FORESEE) *!
!* *!
!* SR gen_one_coh for: *!
!* planting of small trees given by *.pla *!
!* used in prep_stand *!
!* SR is called by flag_reg=20 *!
!* *!
!* 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 *!
!* *!
!*****************************************************************!
SUBROUTINE gen_one_coh(taxid,age,pl_height,nplant)
USE data_stand
USE data_simul
USE data_species
USE data_soil
USE data_help
USE data_plant
USE data_manag
IMPLICIT NONE
integer :: nplant, &
taxid, &
j,nr
real :: age, &
pl_height, &
hhelp,x1,x2,xacc,shelp
real :: rtflsp, sapwood
real :: troot2
TYPE(cohort) ::tree_ini
external sapwood
external rtflsp
call coh_initial (tree_ini)
max_coh = max_coh + 1
tree_ini%ident = max_coh
tree_ini%species = taxid
tree_ini%ntreea = nplant
tree_ini%nta = tree_ini%ntreea
tree_ini%x_age = age
tree_ini%height = pl_height
hhelp = tree_ini%height
IF (taxid.ne.2) tree_ini%x_sap = exp(( LOG(hhelp)-LOG(spar(taxid)%pheight1))/spar(taxid)%pheight2)/1000000.
IF (taxid.eq.2) THEN
x1 = 1.
x2 = 2.
xacc=(1.0e-10)*(x1+x2)/2
! solve equation for calculation of sapwood from height; determine root
heihelp = tree_ini%height
shelp=rtflsp(sapwood,x1,x2,xacc)
tree_ini%x_sap = (10**shelp)/1000000 ! transformation mg ---> kg
ENDIF
! leaf matter
tree_ini%x_fol = (spar(taxid)%seeda*(tree_ini%x_sap** spar(taxid)%seedb)) ![kg]
! fine root matter rough estimate
tree_ini%x_frt = tree_ini%x_fol
! cross sectional area of heartwood
tree_ini%x_crt = tree_ini%x_sap * spar(tree_ini%species)%alphac*spar(tree_ini%species)%cr_frac
tree_ini%x_tb = tree_ini%x_sap * spar(tree_ini%species)%alphac*(1.-spar(tree_ini%species)%cr_frac)
tree_ini%med_sla = spar(taxid)%psla_min + spar(taxid)%psla_a*0.5
tree_ini%t_leaf = tree_ini%med_sla* tree_ini%x_fol ! [m-2]
tree_ini%ca_ini = tree_ini%t_leaf
! initialize pheno state variables
IF(spar(tree_ini%species)%Phmodel==1) THEN
tree_ini%P=0
tree_ini%I=1
ELSE
tree_ini%P=0
tree_ini%I=0
tree_ini%Tcrit=0
END IF
IF(nplant.ne.0.) then
IF (.not. associated(pt%first)) THEN
ALLOCATE (pt%first)
pt%first%coh = tree_ini
NULLIFY(pt%first%next)
! root distribution
call root_depth (1, pt%first%coh%species, pt%first%coh%x_age, pt%first%coh%height, pt%first%coh%x_frt, pt%first%coh%x_crt, nr, troot2, pt%first%coh%x_rdpt, pt%first%coh%nroot)
pt%first%coh%nroot = nr
do j=1,nr
pt%first%coh%rooteff = 1. ! assumption for the first use
enddo
do j=nr+1, nlay
pt%first%coh%rooteff = 0. ! layers with no roots
enddo
ELSE
ALLOCATE(zeig)
zeig%coh = tree_ini
zeig%next => pt%first
pt%first => zeig
! root distribution
call root_depth (1, zeig%coh%species, zeig%coh%x_age, zeig%coh%height, zeig%coh%x_frt, zeig%coh%x_crt, nr, troot2, zeig%coh%x_rdpt, zeig%coh%nroot)
zeig%coh%nroot = nr
do j=1,nr
zeig%coh%rooteff = 1. ! assumption for the first use
enddo
do j=nr+1, nlay
zeig%coh%rooteff = 0. ! layers with no roots
enddo
END IF
anz_coh=anz_coh+1
END IF
END SUBROUTINE gen_one_coh