source: branches/publications/ORCHIDEE_GLUC_r6545/src_stomate/lpj_kill.f90 @ 6737

Last change on this file since 6737 was 4719, checked in by albert.jornet, 7 years ago

Merge: from revisions [4491:4695/trunk/ORCHIDEE]

Merge done in [4671:4718/perso/albert.jornet/MICT_MERGE]
  • Property svn:keywords set to HeadURL Date Author Revision
File size: 10.8 KB
Line 
1! =================================================================================================================================
2! MODULE       : lpj_kill
3!
4! CONTACT      : orchidee-help _at_ listes.ipsl.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_cov_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_cov_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_cov_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) .AND. .NOT. pasture(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 .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                   biomass(:,j,ileaf,m) = zero
185                   biomass(:,j,isapabove,m) = zero
186                   biomass(:,j,isapbelow,m) = zero
187                   biomass(:,j,iheartabove,m) = zero
188                   biomass(:,j,iheartbelow,m) = zero
189                   biomass(:,j,iroot,m) = zero
190                   biomass(:,j,ifruit,m) = zero
191                   biomass(:,j,icarbres,m) = zero
192
193                ENDWHERE   ! was_killed
194
195             END DO
196
197            !! 1.4 Update veget_cov_max in DGVM
198            !      Update veget_cov_max in DGVM for killed PFTs and reset RIP_time
199            IF (ok_dgvm) THEN
200
201                WHERE ( was_killed(:) )
202                   PFTpresent(:,j) = .FALSE.
203
204                   veget_cov_max(:,j) = zero
205                   
206                   RIP_time(:,j) = zero
207
208                ENDWHERE  ! was_killed
209
210            ENDIF ! ok_dgvm
211
212            !! 1.5 Reinitialize vegetation characteristics in DGVM and STOMATE
213            !      Reinitialize number of individuals, crown area and age
214            WHERE ( was_killed(:) )
215
216                ind(:,j) = zero
217
218                cn_ind(:,j) = zero
219
220                senescence(:,j) = .FALSE.
221
222                age(:,j) = zero
223
224                when_growthinit(:,j) = large_value 
225
226                everywhere(:,j) = zero
227
228!                veget(:,j) = zero
229!MM à imposer ?!
230!                lai(:,j) = zero
231
232             ENDWHERE   ! was_killed
233
234             !! 1.6 Update leaf ages
235             DO m = 1, nleafages
236
237                WHERE ( was_killed(:) )
238
239                   leaf_age(:,j,m) = zero 
240                   leaf_frac(:,j,m) = zero 
241
242                ENDWHERE ! was_killed
243
244             ENDDO
245
246             !! 1.7 Print sub routine messages
247             IF ( printlev>=2 ) THEN
248
249                WRITE(numout,*) 'kill: eliminated ',PFT_name(j)
250                WRITE(numout,*) '  at ',COUNT( was_killed(:) ),' points after '//whichroutine
251
252             ENDIF
253
254          ENDIF     ! PFT must be killed at at least one place
255
256       ENDIF       ! PFT is natural
257
258    ENDDO         ! loop over PFTs
259
260    IF (printlev>=4) WRITE(numout,*) 'Leaving kill'
261
262  END SUBROUTINE kill
263
264END MODULE lpj_kill
Note: See TracBrowser for help on using the repository browser.