source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_prescribe.f90 @ 880

Last change on this file since 880 was 720, checked in by didier.solyga, 12 years ago

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