1 | ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_crown.f90,v 1.12 2009/01/06 15:01:25 ssipsl Exp $ |
---|
2 | ! IPSL (2006) |
---|
3 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
---|
4 | !- |
---|
5 | MODULE lpj_crown |
---|
6 | !--------------------------------------------------------------------- |
---|
7 | !- calculate individual crown area from stem mass. |
---|
8 | !--------------------------------------------------------------------- |
---|
9 | USE ioipsl |
---|
10 | USE stomate_constants |
---|
11 | USE constantes_veg |
---|
12 | !- |
---|
13 | IMPLICIT NONE |
---|
14 | !- |
---|
15 | ! private & public routines |
---|
16 | !- |
---|
17 | PRIVATE |
---|
18 | PUBLIC crown |
---|
19 | !- |
---|
20 | CONTAINS |
---|
21 | !- |
---|
22 | !=== |
---|
23 | !- |
---|
24 | SUBROUTINE crown & |
---|
25 | & (npts, PFTpresent, ind, biomass, veget_max, cn_ind, height) |
---|
26 | !--------------------------------------------------------------------- |
---|
27 | ! 0 declarations |
---|
28 | !- |
---|
29 | ! 0.1 input |
---|
30 | !- |
---|
31 | ! Domain size |
---|
32 | INTEGER(i_std),INTENT(in) :: npts |
---|
33 | ! Is pft there |
---|
34 | LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: PFTpresent |
---|
35 | ! density of individuals (1/(m**2 of ground)) |
---|
36 | REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ind |
---|
37 | ! biomass (gC/(m**2 of ground)) |
---|
38 | REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: biomass |
---|
39 | !- |
---|
40 | ! 0.2 modified fields |
---|
41 | !- |
---|
42 | ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground |
---|
43 | !- |
---|
44 | REAL(r_std),DIMENSION(npts,nvm),INTENT(inout) :: veget_max |
---|
45 | !- |
---|
46 | ! 0.3 output |
---|
47 | !- |
---|
48 | ! crown area (m**2) per ind. |
---|
49 | !- |
---|
50 | REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: cn_ind |
---|
51 | !- |
---|
52 | ! height of vegetation (m) |
---|
53 | !- |
---|
54 | REAL(r_std),DIMENSION(npts,nvm),INTENT(inout) :: height |
---|
55 | !- |
---|
56 | ! 0.4 local |
---|
57 | !- |
---|
58 | ! wood mass of an individual |
---|
59 | !- |
---|
60 | REAL(r_std),DIMENSION(npts) :: woodmass |
---|
61 | !- |
---|
62 | ! index |
---|
63 | !- |
---|
64 | INTEGER(i_std) :: j |
---|
65 | !- |
---|
66 | ! stem diameter |
---|
67 | !- |
---|
68 | REAL(r_std),DIMENSION(npts) :: dia |
---|
69 | REAL(r_std),DIMENSION(nvm) :: height_presc_12 |
---|
70 | !--------------------------------------------------------------------- |
---|
71 | !- |
---|
72 | ! 1 initializations |
---|
73 | !- |
---|
74 | ! 1.1 check if DGVM activated |
---|
75 | !- |
---|
76 | IF (.NOT.control%ok_dgvm) THEN |
---|
77 | STOP 'crown: not to be called with static vegetation.' |
---|
78 | ENDIF |
---|
79 | !- |
---|
80 | ! 1.2 initialize output to zero |
---|
81 | !- |
---|
82 | cn_ind(:,:) = zero |
---|
83 | ! no convertion, just cop |
---|
84 | height_presc_12(1:nvm) = height_presc(1:nvm) |
---|
85 | !- |
---|
86 | ! 2 calculate (or prescribe) crown area |
---|
87 | !- |
---|
88 | DO j = 2,nvm |
---|
89 | IF (tree(j)) THEN |
---|
90 | !----- |
---|
91 | !---- 2.1 trees |
---|
92 | !----- |
---|
93 | IF (natural(j)) THEN |
---|
94 | !------ 2.1.1 natural |
---|
95 | WHERE (PFTpresent(:,j) .AND.ind(:,j).GT.min_stomate) |
---|
96 | !-------- 2.1.1.1 calculate individual wood mass |
---|
97 | woodmass(:) = & |
---|
98 | & (biomass(:,j,isapabove)+biomass(:,j,isapbelow) & |
---|
99 | & +biomass(:,j,iheartabove)+biomass(:,j,iheartbelow))/ind(:,j) |
---|
100 | !-------- 2.1.1.2 stem diameter (pipe model) |
---|
101 | dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) & |
---|
102 | & **(1./(2.+pipe_tune3)) |
---|
103 | !-------- 2.1.1.3 height |
---|
104 | height(:,j) = pipe_tune2*(dia(:)**pipe_tune3) |
---|
105 | WHERE (height(:,j) > height_presc_12(j)) |
---|
106 | dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3) |
---|
107 | height(:,j) = height_presc_12(j) |
---|
108 | ENDWHERE |
---|
109 | !-------- 2.1.1.4 crown area: for large truncs, crown area cannot |
---|
110 | !-------- exceed a certain value, prescribed through maxdia. |
---|
111 | cn_ind(:,j) = pipe_tune1*MIN(dia(:),maxdia(j))**1.6 |
---|
112 | ENDWHERE |
---|
113 | ELSE |
---|
114 | !------ 2.1.2 tree is agricultural - stop |
---|
115 | STOP 'crown: cannot treat agricultural trees.' |
---|
116 | ENDIF |
---|
117 | ELSE |
---|
118 | !----- |
---|
119 | !---- 2.2 grasses |
---|
120 | !----- |
---|
121 | WHERE (PFTpresent(:,j)) |
---|
122 | !------ 2.2.1 an "individual" is 1 m**2 of grass |
---|
123 | cn_ind(:,j) = un |
---|
124 | ENDWHERE |
---|
125 | ENDIF |
---|
126 | !--- |
---|
127 | !-- 2.3 recalculate vegetation cover if natural |
---|
128 | ! ind and cn_ind are 0 if not present |
---|
129 | !--- |
---|
130 | !SZ isn't this physically inconsistent with the assumptions of sechiba?? |
---|
131 | ! the actual LPJ formulation calculates fpc from maximum LAI, and fpar from actual LAI=veget |
---|
132 | IF (natural(j).AND.control%ok_dgvm) THEN |
---|
133 | veget_max(:,j) = ind(:,j) * cn_ind(:,j) |
---|
134 | ENDIF |
---|
135 | ENDDO |
---|
136 | !------------------- |
---|
137 | END SUBROUTINE crown |
---|
138 | !- |
---|
139 | !=== |
---|
140 | !- |
---|
141 | END MODULE lpj_crown |
---|