source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_crown.f90 @ 107

Last change on this file since 107 was 64, checked in by didier.solyga, 14 years ago

Import first version of ORCHIDEE_EXT

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