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