source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_prescribe.f90 @ 64

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

Import first version of ORCHIDEE_EXT
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_data
19  USE pft_parameters
20  USE constantes
21
22
23  IMPLICIT NONE
24
25  ! private & public routines
26
27  PRIVATE
28  PUBLIC prescribe,prescribe_clear
29
30    ! first call
31    LOGICAL, SAVE                                              :: firstcall = .TRUE.
32
33CONTAINS
34
35  SUBROUTINE prescribe_clear
36    firstcall=.TRUE.
37  END SUBROUTINE prescribe_clear
38 
39 SUBROUTINE prescribe (npts, &
40                        veget_max, PFTpresent, everywhere, when_growthinit, &
41                        biomass, leaf_frac, ind, cn_ind)
42
43    !
44    ! 0 declarations
45    !
46
47    ! 0.1 input
48
49    ! Domain size
50    INTEGER(i_std), INTENT(in)                                        :: npts
51
52    ! 0.2 modified fields
53
54    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
55    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
56    ! PFT present
57    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent
58    ! is the PFT everywhere in the grid box or very localized (after its introduction)
59    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: everywhere
60    ! how many days ago was the beginning of the growing season
61    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: when_growthinit
62    ! biomass (gC/(m**2 of ground))
63    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)     :: biomass
64    ! fraction of leaves in leaf age class
65    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac
66    ! density of individuals (1/(m**2 of ground))
67    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ind
68    ! crown area of individuals (m**2)
69    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: cn_ind
70
71    ! 0.3 output
72
73
74    ! 0.4 local
75
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) ) ** pipe_tune_exp_coeff
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))**(pipe_tune_exp_coeff/(2.+pipe_tune3)) ) ) &
146                             ** (1./(1.-(pipe_tune_exp_coeff/(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) ) ** pipe_tune_exp_coeff
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) ) ** pipe_tune_exp_coeff
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,:) = (bm_sapl_rescale * 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_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.