source: tags/ORCHIDEE/src_stomate/lpj_gap.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: 6.7 KB
Line 
1! gap routine - place for new plants
2!
3! Death rate of trees is estimated by evaluating their vigour (based on npp).
4! For large availabilities, lifetime is 50 years (!?).
5! Age of stands is not considered, although availability death rate should probably
6! depend on age.
7!
8! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_gap.f90,v 1.10 2009/01/06 15:01:25 ssipsl Exp $
9! IPSL (2006)
10!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
11!
12MODULE lpj_gap
13
14  ! modules used:
15
16  USE ioipsl
17  USE stomate_constants
18  USE constantes_veg
19  USE parallel
20
21  IMPLICIT NONE
22
23  ! private & public routines
24
25  PRIVATE
26  PUBLIC gap,gap_clear
27
28  ! first call
29  LOGICAL, SAVE                                           :: firstcall = .TRUE.
30
31CONTAINS
32
33
34  SUBROUTINE gap_clear
35    firstcall = .TRUE.
36  END SUBROUTINE gap_clear
37
38  SUBROUTINE gap (npts, dt, &
39       npp_longterm, turnover_longterm, lm_lastyearmax, &
40       PFTpresent, biomass, ind, bm_to_litter)
41
42    !
43    ! 0 declarations
44    !
45
46    ! 0.1 input
47
48    ! Domain size
49    INTEGER(i_std), INTENT(in)                                     :: npts
50    ! Time step (days)
51    REAL(r_std), INTENT(in)                                  :: dt
52    ! "long term" net primary productivity (gC/(m**2 of ground)/year)
53    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: npp_longterm
54    ! "long term" turnover rate (gC/(m**2 of ground)/year)
55    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)     :: turnover_longterm
56    ! last year's maximum leaf mass, for each PFT (gC/(m**2 of ground))
57    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lm_lastyearmax
58
59    ! 0.2 modified fields
60
61    ! Is pft there
62    LOGICAL, DIMENSION(npts,nvm), INTENT(in)            :: PFTpresent
63    ! biomass (gC/(m**2 of ground))
64    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)  :: biomass
65    ! Number of individuals / (m**2 of ground)
66    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: ind
67    ! biomass taken away (gC/(m**2 of ground))
68    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)  :: bm_to_litter
69
70    ! 0.3 local
71
72    ! which kind of mortality
73    LOGICAL, SAVE                                           :: constant_mortality
74    ! biomass increase
75    REAL(r_std), DIMENSION(npts)                             :: delta_biomass
76    ! vigour
77    REAL(r_std), DIMENSION(npts)                             :: vigour
78    ! natural availability, based on vigour
79    REAL(r_std), DIMENSION(npts)                             :: availability
80    ! mortality (fraction of trees that is dying per time step), per day in history file
81    REAL(r_std), DIMENSION(npts,nvm)                        :: mortality
82    ! indices
83    INTEGER(i_std)                                           :: j,k
84
85    ! =========================================================================
86
87    IF ( firstcall ) THEN
88
89       firstcall = .FALSE.
90
91       !Config  Key  = LPJ_GAP_CONST_MORT
92       !Config  Desc = constant tree mortality
93       !Config  Def  = y
94       !Config  Help = If yes, then a constant mortality is applied to trees.
95       !Config         Otherwise, mortality is a function of the trees'
96       !Config         vigour (as in LPJ).
97
98       constant_mortality = .TRUE.
99       CALL getin_p('LPJ_GAP_CONST_MORT', constant_mortality)     
100       WRITE(numout,*) 'gap: constant mortality:', constant_mortality
101
102    ENDIF
103
104    IF (bavard.GE.3) WRITE(numout,*) 'Entering gap'
105
106    mortality(:,:) = zero
107
108    DO j = 2,nvm
109
110       ! only trees
111
112       IF ( tree(j) ) THEN
113
114          !
115          ! 1 determine availability
116          !
117
118          IF ( .NOT. constant_mortality ) THEN
119
120             !
121             ! 1.1 original formulation: mortality depends on vigour
122             !
123
124             WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) )
125
126                ! how much did the tree grow per year?
127
128                delta_biomass(:) = &
129                     MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + &
130                     turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) ), &
131                     0._r_std )
132
133                ! scale this to the leaf surface of the tree
134
135                vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j)) / 70.
136
137             ELSEWHERE
138
139                vigour(:) = 0.0
140
141             ENDWHERE
142
143             WHERE ( PFTpresent(:,j) )
144
145                ! note that availability is never above 0.02, i.e. lifetime of 50 years when very
146                ! low vigour.
147
148                availability(:) = 0.02 / ( 1.+vigour(:)/0.17 )
149
150                ! Mortality (fraction per time step).
151                ! In the original DGVM, mortality was set to zero if there was strong fire
152                ! perturbation.
153                ! This has been de-activated since the npp is not influenced by fire,
154                ! as opposed to the original DGVM. Instead, mortality is simply
155                ! equal to the availability, modulated by the time step.
156                ! Exact formulation: mor = 1. - ( 1. - availability ) ** (dt/one_year)
157                ! approximation ok as availability < 0.02 << 1
158
159                mortality(:,j) = availability(:) * dt/one_year
160
161             ENDWHERE
162
163          ELSE
164
165             !
166             ! 1.2 Alternative version: Constant mortality
167             !
168
169             WHERE ( PFTpresent(:,j) )
170
171                mortality(:,j) = dt/(residence_time(j)*one_year)
172
173             ENDWHERE
174
175          ENDIF
176
177          !
178          ! 2 Special for the DGVM:
179          !   mortality is one if npp is zero or negative.
180          !
181
182          IF ( control%ok_dgvm ) THEN
183
184             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. min_stomate ) )
185
186                mortality(:,j) = 1.
187
188             ENDWHERE
189
190          ENDIF
191
192          !
193          ! 3 update biomass, create litter
194          !
195
196          DO k = 1, nparts
197
198             WHERE ( PFTpresent(:,j) )
199
200                bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + mortality(:,j) * biomass(:,j,k)
201
202                biomass(:,j,k) = biomass(:,j,k) * ( 1. - mortality(:,j) )
203
204             ENDWHERE
205
206          ENDDO
207
208          !
209          ! 4 update number of individuals
210          !
211
212          IF ( control%ok_dgvm ) THEN
213
214             WHERE ( PFTpresent(:,j) )
215
216                ind(:,j) = ind(:,j) * ( 1. - mortality(:,j) )
217
218             ENDWHERE
219
220          ENDIF
221
222       ENDIF       ! only trees
223
224    ENDDO         ! loop over pfts
225
226    !
227    ! 5 history
228    !
229
230    ! output in fraction of trees that dies/day.
231    ! exact formulation: 1. - ( 1. - mortality ) ** (1./dt)
232    mortality = mortality / dt
233
234    CALL histwrite (hist_id_stomate, 'MORTALITY', itime, &
235         mortality, npts*nvm, horipft_index)
236
237    IF (bavard.GE.4) WRITE(numout,*) 'Leaving gap'
238
239  END SUBROUTINE gap
240
241END MODULE lpj_gap
Note: See TracBrowser for help on using the repository browser.