source: tags/ORCHIDEE/src_stomate/stomate_prescribe.f90 @ 6

Last change on this file since 6 was 6, checked in by orchidee, 14 years ago

import first tag equivalent to CVS orchidee_1_9_5 + OOL_1_9_5
File size: 8.3 KB
Line 
1! Initialize density of individuals and crown area to some reasonable value
2!   if the DGVM is not (yet) activated.
3! Prescribe density of individuals and crown area for agricultural PFTs.
4! At first call, if the DGVM is not (yet) activated, impose some biomass if zero
5!   for a prescribed PFT. Initialize leaf age classes.
6! At first call, if the DGVM is not (yet) activated, declare PFT present if its
7!   prescribed vegetation cover is above 0
8!
9! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_prescribe.f90,v 1.10 2009/01/07 12:56:10 ssipsl Exp $
10! IPSL (2006)
11!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
12!
13MODULE stomate_prescribe
14
15  ! modules used:
16
17  USE ioipsl
18  USE stomate_constants
19  USE constantes_veg
20
21  IMPLICIT NONE
22
23  ! private & public routines
24
25  PRIVATE
26  PUBLIC prescribe,prescribe_clear
27
28    ! first call
29    LOGICAL, SAVE                                              :: firstcall = .TRUE.
30
31CONTAINS
32
33  SUBROUTINE prescribe_clear
34    firstcall=.TRUE.
35  END SUBROUTINE prescribe_clear
36 
37 SUBROUTINE prescribe (npts, &
38                        veget_max, PFTpresent, everywhere, when_growthinit, &
39                        biomass, leaf_frac, ind, cn_ind)
40
41    !
42    ! 0 declarations
43    !
44
45    ! 0.1 input
46
47    ! Domain size
48    INTEGER(i_std), INTENT(in)                                        :: npts
49
50    ! 0.2 modified fields
51
52    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
53    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
54    ! PFT present
55    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent
56    ! is the PFT everywhere in the grid box or very localized (after its introduction)
57    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: everywhere
58    ! how many days ago was the beginning of the growing season
59    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: when_growthinit
60    ! biomass (gC/(m**2 of ground))
61    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)     :: biomass
62    ! fraction of leaves in leaf age class
63    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac
64    ! density of individuals (1/(m**2 of ground))
65    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ind
66    ! crown area of individuals (m**2)
67    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: cn_ind
68
69    ! 0.3 output
70
71
72    ! 0.4 local
73
74    ! generic tree crown area (m**2)
75    REAL(r_std), PARAMETER                                      :: cn_tree = 4.
76    ! stem diameter (m)
77    REAL(r_std), DIMENSION(npts)                                :: dia
78    ! woodmass (gC/(m**2 of ground))
79    REAL(r_std), DIMENSION(npts)                                :: woodmass
80    ! woodmass of an individual (gC)
81    REAL(r_std), DIMENSION(npts)                                :: woodmass_ind
82    ! index
83    INTEGER(i_std)                                             :: i,j
84
85    ! =========================================================================
86
87    DO j = 2,nvm
88
89      ! only when the DGVM is not activated or agricultural PFT.
90
91      IF ( ( .NOT. control%ok_dgvm ) .OR. ( .NOT. natural(j) ) ) THEN
92
93        !
94        ! 1 crown area
95        !
96
97        cn_ind(:,j) = 0.0
98
99        IF ( tree(j) ) THEN
100
101          !
102          ! 1.1 trees
103          !
104
105          dia(:) = 0.0
106
107          DO i = 1, npts
108
109            IF ( veget_max(i,j) .GT. 0.0 ) THEN
110
111              ! 1.1.1 calculate total wood mass
112
113              woodmass(i) = (biomass(i,j,isapabove) + biomass(i,j,isapbelow) + &
114                   biomass(i,j,iheartabove) + biomass(i,j,iheartbelow)) * veget_max(i,j) 
115
116              IF ( woodmass(i) .GT. min_stomate ) THEN
117
118                ! 1.1.2 calculate critical density of individuals
119
120                ind(i,j) = woodmass(i) / &
121                           ( pipe_density*pi/4.*pipe_tune2 * maxdia(j)**(2.+pipe_tune3) )
122
123                ! 1.1.3 individual biomass corresponding to this critical density of individuals
124
125                woodmass_ind(i) = woodmass(i) / ind(i,j)
126
127                ! 1.1.4 stem diameter
128
129                dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
130                         ( 1. / ( 2. + pipe_tune3 ) )
131
132                ! 1.1.5 crown area, provisional
133
134                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** 1.6
135
136                ! 1.1.6 do we have to recalculate the crown area?
137
138                IF ( cn_ind(i,j) * ind(i,j) .GT. 1.002* veget_max(i,j) ) THEN
139
140                  ind(i,j) = veget_max(i,j) / cn_ind(i,j)
141
142                ELSE
143
144                  ind(i,j) = ( veget_max(i,j) / &
145                               ( pipe_tune1 * (woodmass(i)/(pipe_density*pi/4.*pipe_tune2))**(1.6/(2.+pipe_tune3)) ) ) &
146                             ** (1./(1.-(1.6/(2.+pipe_tune3))))
147
148                  woodmass_ind(i) = woodmass(i) / ind(i,j)
149
150                  dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
151                           ( 1. / ( 2. + pipe_tune3 ) )
152
153                  ! final crown area
154                  cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** 1.6
155
156                ENDIF
157
158              ELSE
159
160                ! woodmass = 0 => impose some value
161
162                dia(:) = maxdia(j)
163
164                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** 1.6
165
166              ENDIF
167
168            ENDIF    ! veget_max .GT. 0.
169
170          ENDDO      ! loop over grid points
171
172        ELSE
173
174          !
175          ! 1.2 grasses: always 1m**2
176          !
177
178          WHERE ( veget_max(:,j) .GT. 0.0 )
179            cn_ind(:,j) = 1.0
180          ENDWHERE
181
182        ENDIF   ! tree/grass?
183
184        !
185        ! 2 density of individuals
186        !
187
188        WHERE ( veget_max(:,j) .GT. 0.0 )
189
190          ind(:,j) = veget_max(:,j) / cn_ind(:,j)
191
192        ELSEWHERE
193
194          ind(:,j) = 0.0
195
196        ENDWHERE
197
198      ENDIF     ! not natural or DGVM not activated?
199
200    ENDDO       ! loop over PFTs
201
202    !
203    ! 4 first call
204    !
205
206    IF ( firstcall ) THEN
207
208      WRITE(numout,*) 'prescribe:'
209
210      ! impose some biomass if zero and PFT prescribed
211
212      WRITE(numout,*) '   > Imposing initial biomass for prescribed trees, '// &
213                      'initial reserve mass for prescribed grasses.'
214      WRITE(numout,*) '   > Declaring prescribed PFTs present.'
215
216      DO j = 2,nvm
217        DO i = 1, npts
218
219          ! is vegetation static or PFT agricultural?
220
221          IF ( ( .NOT. control%ok_dgvm ) .OR. &
222               ( ( .NOT. natural(j) ) .AND. ( veget_max(i,j) .GT. min_stomate ) ) ) THEN
223
224            !
225            ! 4.1 trees
226            !
227
228            IF ( tree(j) .AND. &
229                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
230                 ( SUM( biomass(i,j,:) ) .LE. min_stomate ) ) THEN
231
232               IF (veget_max(i,j) .GT. min_stomate) THEN
233                  biomass(i,j,:) = (40. * bm_sapl(j,:) * ind(i,j)) / veget_max(i,j)
234               ELSE
235                  biomass(i,j,:) = zero
236               ENDIF
237
238              ! set leaf age classes
239              leaf_frac(i,j,:) = zero
240              leaf_frac(i,j,1) = un
241
242              ! set time since last beginning of growing season
243              when_growthinit(i,j) = large_value
244
245              ! seasonal trees: no leaves at beginning
246
247              IF ( pheno_crit%pheno_model(j) .NE. 'none' ) THEN
248
249                biomass(i,j,ileaf) = 0.0
250                leaf_frac(i,j,1) = 0.0
251
252              ENDIF
253
254            ENDIF
255
256            !
257            ! 4.2 grasses
258            !
259
260            IF ( ( .NOT. tree(j) ) .AND. &
261                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
262                 ( SUM( biomass(i,j,:) ) .LE. min_stomate ) ) THEN
263
264              biomass(i,j,icarbres) = bm_sapl(j,icarbres) * ind(i,j) / veget_max(i,j)
265
266              ! set leaf age classes
267              leaf_frac(i,j,:) = 0.0
268              leaf_frac(i,j,1) = 1.0
269
270              ! set time since last beginning of growing season
271              when_growthinit(i,j) = large_value
272
273            ENDIF
274
275            !
276            ! 4.3 declare PFT present everywhere in that grid box
277            !
278
279            IF ( veget_max(i,j) .GT. min_stomate ) THEN
280              PFTpresent(i,j) = .TRUE.
281              everywhere(i,j) = 1.
282            ENDIF
283
284          ENDIF   ! not control%ok_dgvm  or agricultural
285
286        ENDDO
287      ENDDO
288
289      firstcall = .FALSE.
290
291    ENDIF
292
293  END SUBROUTINE prescribe
294
295END MODULE stomate_prescribe
Note: See TracBrowser for help on using the repository browser.