source: branches/publications/ORCHIDEE_gmd-2018-261/src_stomate/lpj_kill.f90 @ 8692

Last change on this file since 8692 was 2765, checked in by nicolas.vuichard, 10 years ago

Trunk version with the allocation scheme of ORCHIDEE-CAN
  • Property svn:keywords set to HeadURL Date Author Revision
File size: 11.0 KB
Line 
1! =================================================================================================================================
2! MODULE       : lpj_kill
3!
4! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
5!
6! LICENCE      : IPSL (2006)
7! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF         Kills natural PFTs with low biomass and low number of individuals.
10!!
11!!\n DESCRIPTION: None
12!!
13!! RECENT CHANGE(S): None
14!!
15!! REFERENCE(S) :
16!!
17!! SVN          :
18!! $HeadURL$
19!! $Date$
20!! $Revision$
21!! \n
22!_ ================================================================================================================================
23
24
25MODULE lpj_kill
26
27  ! modules used:
28
29  USE ioipsl_para
30  USE stomate_data
31  USE pft_parameters
32  USE constantes
33
34  IMPLICIT NONE
35
36  ! private & public routines
37
38  PRIVATE
39  PUBLIC kill
40
41CONTAINS
42
43!! ================================================================================================================================
44!! SUBROUTINE  : kill
45!!
46!>\BRIEF       Kills natural pfts that have low biomass or low number of individuals,
47!! returns biomass to litter pools,  and resets biomass to zero. 
48!!
49!! DESCRIPTION : Kills natural PFTS. The PFT vegetation characteristics are
50!! reinitialized. Kill is either done in DGVM mode or in non-DGVM mode
51!!
52!! RECENT CHANGE(S): None
53!!
54!! MAIN OUTPUT VARIABLE(S): senescence, PFTpresent, cn_ind, ind, RIP_time, age, when_growthinit,
55!! everywhere,beget, veget_max, npp_longterm, biomass, bm_to_litter, leaf_age, leaf_frac
56!!
57!! REFERENCE(S) : None
58!!
59!! FLOWCHART    : None
60!! \n
61!_ ================================================================================================================================
62
63  SUBROUTINE kill (npts, whichroutine, lm_lastyearmax, &
64       ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
65       lai, age, leaf_age, leaf_frac, npp_longterm, &
66       when_growthinit, everywhere, veget_max, bm_to_litter)
67
68 !! 0. Variable and parameter description
69
70    !! 0.1 Input variables
71
72    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
73    CHARACTER(LEN=10), INTENT(in)                             :: whichroutine    !! Message (unitless)
74    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai             !! [DISPENSABLE] leaf area index OF AN INDIVIDUAL PLANT
75                                                                                 !! @tex $(m^2 m^{-2})$ @endtex
76    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT
77                                                                                 !! @tex $(gC.m^{-2})$ @endtex
78
79    !! 0.2 Output variables
80
81
82    !! 0.3 Modified variables
83
84    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Is the plant senescent? (only for deciduous
85                                                                                 !! trees - carbohydrate reserve) (true/false)
86    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! Is pft there (true/false)
87    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! Crown area of individuals
88                                                                                 !! @tex $(m^2)$ @endtex
89    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals
90                                                                                 !! @tex $(m^{-2})$ @endtex
91    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for
92                                                                                 !! the last time (y)
93    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years) 
94    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! How many days ago was the beginning of the
95                                                                                 !! growing season (days)
96    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! Is the PFT everywhere in the grid box or very
97                                                                                 !! localized (after its introduction)
98    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "Maximal" coverage fraction of a PFT (LAI ->
99                                                                                 !! infinity) on ground (unitless;0-1)
100    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "Long term" (default = 3-year) net primary
101                                                                                 !! productivity
102                                                                                 !! @tex $(gC.m^{-2} year^{-1})$ @endtex
103    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! Leaf age (days)
104    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class
105                                                                                 !! (unitless;0-1)
106    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass       !! Biomass @tex $(gC.m^{-2})$ @endtex
107    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter  !! Conversion of biomass to litter
108                                                                                      !! @tex $(gC.m^{-2} day^{-1})$ @endtex
109
110    !! 0.4 Local variables
111
112    INTEGER(i_std)                                            :: j,m             !! Indices       (unitless)
113    LOGICAL, DIMENSION(npts)                                  :: was_killed      !! Bookkeeping   (true/false)
114
115!_ ================================================================================================================================
116
117    IF (printlev>=3) WRITE(numout,*) 'Entering kill'
118
119 !! 1. Kill PFTs
120
121    ! Kill plants if number of individuals or last year's leaf mass is close to zero.
122    ! the "was_killed" business is necessary for a more efficient code on the VPP processor
123    DO j = 2,nvm ! loop plant functional types
124
125       was_killed(:) = .FALSE.
126
127       IF ( natural(j) ) THEN
128
129          !! 1.1 Kill natural PFTs when DGVM is activated
130          IF ( ok_dgvm ) THEN
131             WHERE ( PFTpresent(:,j) .AND. &
132                  ( ( ind(:,j) .LT. min_stomate ) .OR. &
133                  ( lm_lastyearmax(:,j) .LT. min_stomate ) ) )
134             
135                was_killed(:) = .TRUE.
136             
137             ENDWHERE
138         
139          ELSE
140
141             !! 1.2 Kill natural PFTs when running STOMATE without DGVM
142
143             !! 1.2.1 Kill PFTs
144             WHERE ( PFTpresent(:,j) .AND. & 
145                  (((biomass(:,j,icarbres,icarbon) .LE.zero).AND.(biomass(:,j,ilabile,icarbon) .LE.zero)) .OR. & 
146                  biomass(:,j,iroot,icarbon).LT.-min_stomate .OR. biomass(:,j,ileaf,icarbon).LT.-min_stomate ).AND. & 
147                  ind(:,j).GT. zero)
148
149                was_killed(:) = .TRUE.
150
151             ENDWHERE
152
153             !! 1.2.2 Overwrite long-term NPP for grasses
154             IF(.NOT.is_tree(j).AND..NOT.lpj_gap_const_mort)THEN
155                WHERE ( was_killed(:) )
156
157                   npp_longterm(:,j) = 500.
158
159                ENDWHERE
160             ENDIF
161
162          ENDIF ! ok_dgvm
163
164          !! 1.3 Bookkeeping for PFTs that were killed
165          !      For PFTs that were killed, return biomass pools to litter
166          !      and update biomass pools to zero
167          IF ( ANY( was_killed(:) ) ) THEN
168         
169             DO m = 1,nelements
170
171                WHERE ( was_killed(:) )
172
173                   bm_to_litter(:,j,ileaf,m) = bm_to_litter(:,j,ileaf,m) + biomass(:,j,ileaf,m)
174                   bm_to_litter(:,j,isapabove,m) = bm_to_litter(:,j,isapabove,m) + biomass(:,j,isapabove,m)
175                   bm_to_litter(:,j,isapbelow,m) = bm_to_litter(:,j,isapbelow,m) + biomass(:,j,isapbelow,m)
176                   bm_to_litter(:,j,iheartabove,m) = bm_to_litter(:,j,iheartabove,m) + &
177                                                     biomass(:,j,iheartabove,m)
178                   bm_to_litter(:,j,iheartbelow,m) = bm_to_litter(:,j,iheartbelow,m) + &
179                                                     biomass(:,j,iheartbelow,m)
180                   bm_to_litter(:,j,iroot,m) = bm_to_litter(:,j,iroot,m) + biomass(:,j,iroot,m)
181                   bm_to_litter(:,j,ifruit,m) = bm_to_litter(:,j,ifruit,m) + biomass(:,j,ifruit,m)
182                   bm_to_litter(:,j,icarbres,m) = bm_to_litter(:,j,icarbres,m) + biomass(:,j,icarbres,m)
183
184                   bm_to_litter(:,j,ilabile,m) = bm_to_litter(:,j,ilabile,m) + biomass(:,j,ilabile,m)
185                   
186                   
187                   biomass(:,j,ileaf,m) = zero
188                   biomass(:,j,isapabove,m) = zero
189                   biomass(:,j,isapbelow,m) = zero
190                   biomass(:,j,iheartabove,m) = zero
191                   biomass(:,j,iheartbelow,m) = zero
192                   biomass(:,j,iroot,m) = zero
193                   biomass(:,j,ifruit,m) = zero
194                   biomass(:,j,icarbres,m) = zero
195                   biomass(:,j,ilabile,m) = zero
196                ENDWHERE   ! was_killed
197
198             END DO
199
200            !! 1.4 Update veget_max in DGVM
201            !      Update veget_max in DGVM for killed PFTs and reset RIP_time
202            IF (ok_dgvm) THEN
203
204                WHERE ( was_killed(:) )
205                   PFTpresent(:,j) = .FALSE.
206
207                   veget_max(:,j) = zero
208                   
209                   RIP_time(:,j) = zero
210
211                ENDWHERE  ! was_killed
212
213            ENDIF ! ok_dgvm
214
215            !! 1.5 Reinitialize vegetation characteristics in DGVM and STOMATE
216            !      Reinitialize number of individuals, crown area and age
217            WHERE ( was_killed(:) )
218
219                ind(:,j) = zero
220
221                cn_ind(:,j) = zero
222
223                senescence(:,j) = .FALSE.
224
225                age(:,j) = zero
226
227                when_growthinit(:,j) = large_value 
228
229                everywhere(:,j) = zero
230
231!                veget(:,j) = zero
232!MM à imposer ?!
233!                lai(:,j) = zero
234
235             ENDWHERE   ! was_killed
236
237             !! 1.6 Update leaf ages
238             DO m = 1, nleafages
239
240                WHERE ( was_killed(:) )
241
242                   leaf_age(:,j,m) = zero 
243                   leaf_frac(:,j,m) = zero 
244
245                ENDWHERE ! was_killed
246
247             ENDDO
248
249             !! 1.7 Print sub routine messages
250             IF ( printlev>=2 ) THEN
251
252                WRITE(numout,*) 'kill: eliminated ',PFT_name(j)
253                WRITE(numout,*) '  at ',COUNT( was_killed(:) ),' points after '//whichroutine
254
255             ENDIF
256
257          ENDIF     ! PFT must be killed at at least one place
258
259       ENDIF       ! PFT is natural
260
261    ENDDO         ! loop over PFTs
262
263    IF (printlev>=4) WRITE(numout,*) 'Leaving kill'
264
265  END SUBROUTINE kill
266
267END MODULE lpj_kill
Note: See TracBrowser for help on using the repository browser.