source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/lpj_pftinout.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: 14.6 KB
Line 
1! throw out respectively introduce some PFTS
2!
3!< $HeadURL$
4!< $Date$
5!< $Author$
6!< $Revision$
7! IPSL (2006)
8!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
9!
10MODULE lpj_pftinout
11
12  ! modules used:
13
14  USE ioipsl
15  USE stomate_data
16  USE pft_parameters
17  USE constantes
18
19  IMPLICIT NONE
20
21  ! private & public routines
22
23  PRIVATE
24  PUBLIC pftinout,pftinout_clear
25
26  ! first call
27  LOGICAL, SAVE                                             :: firstcall = .TRUE.
28
29CONTAINS
30
31
32  SUBROUTINE pftinout_clear
33    firstcall = .TRUE.
34  END SUBROUTINE pftinout_clear
35
36  SUBROUTINE pftinout (npts, dt, adapted, regenerate, &
37       neighbours, veget, veget_max, &
38       biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
39       PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
40       co2_to_bm, &
41       avail_tree, avail_grass)
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    ! Winter not too cold
54    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: adapted
55    ! Winter sufficiently cold
56    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: regenerate
57    ! indices of the 8 neighbours of each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
58    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)              :: neighbours
59    ! fractional coverage on ground, taking into
60    !   account LAI (=grid-scale fpc)
61    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget
62    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
63    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max
64
65    ! 0.2 modified fields
66
67    ! biomass (gC/(m**2 of ground))
68    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)    :: biomass
69    ! density of individuals 1/m**2
70    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind
71    ! crownarea of individuals m**2
72    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind
73    ! mean age (years)
74    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age
75    ! fraction of leaves in leaf age class
76    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
77    ! "long term" net primary productivity (gC/(m**2 of ground)/year)
78    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm
79    ! last year's maximum leaf mass, for each PFT (gC/(m**2 of ground))
80    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax
81    ! is the plant senescent? (only for deciduous trees - carbohydrate reserve)
82    !         set to .FALSE. if PFT is introduced or killed
83    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: senescence
84    ! PFT exists
85    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: PFTpresent
86    ! is the PFT everywhere in the grid box or very localized (after its introduction)
87    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere
88    ! how many days ago was the beginning of the growing season
89    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit
90    ! in order for this PFT to be introduced, does it have to be present in an
91    !   adjacent grid box?
92    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: need_adjacent
93    ! How much time ago was the PFT eliminated for the last time (y)
94    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time
95    ! biomass uptaken (gC/(m**2 of total ground)/day)
96    !NV passage 2D
97    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm
98
99    ! 0.3 output
100
101    ! space availability for trees
102    REAL(r_std), DIMENSION(npts), INTENT(out)                  :: avail_tree
103    ! space availability for grasses
104    REAL(r_std), DIMENSION(npts), INTENT(out)                  :: avail_grass
105
106    ! 0.4 local
107
108    ! availability
109    REAL(r_std), DIMENSION(npts)                               :: avail
110    ! indices
111    INTEGER(i_std)                                             :: i,j,m
112    ! total woody vegetation cover
113    REAL(r_std), DIMENSION(npts)                               :: sumfrac_wood
114    ! number of adjacent grid cells where PFT is ubiquitious
115    INTEGER(i_std), DIMENSION(npts)                            :: n_present
116    ! we can introduce this PFT
117    LOGICAL, DIMENSION(npts)                                  :: can_introduce
118    ! no real need for dimension(ntps) except for vectorisation
119    REAL(r_std), DIMENSION(npts)                               :: fracnat
120
121    ! =========================================================================
122
123    IF (bavard.GE.3) WRITE(numout,*) 'Entering pftinout'
124
125    !
126    ! 1 Messages
127    !
128
129    IF ( firstcall ) THEN
130
131       WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
132
133       firstcall = .FALSE.
134
135    ENDIF
136
137    !
138    ! 2 Space availability
139    !
140
141    ! 2.1 Only natural part of the grid cell
142    !
143    !SZ bug correction MERGE: need to subtract agricultural area!
144    ! fraction of agricultural surface
145    fracnat(:) = un
146    do j = 2,nvm
147       IF ( .NOT. natural(j) ) THEN
148          fracnat(:) = fracnat(:) - veget_max(:,j)
149       ENDIF
150    ENDDO
151
152    !
153    ! 2.2 total woody fpc on grid
154    !
155    sumfrac_wood(:) = zero
156
157    DO j = 2,nvm
158       !SZ problem here: agriculture, not convinced that this representation of LPJ is correct
159       !if agriculture is present, ind must be recalculated to correspond to the natural density...
160       ! since ind is per grid cell, can be achived by discounting for agricultura fraction
161       IF ( natural(j).AND.tree(j) ) THEN
162          WHERE(fracnat(:).GT.min_stomate)
163                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & 
164                     * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
165                !lai changed to lm_last
166          ENDWHERE
167       ENDIF
168    ENDDO
169
170    avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
171
172    avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
173
174    !
175    ! 3 Time since last elimination (y)
176    !
177
178    RIP_time = RIP_time + dt / one_year
179
180    !
181    ! 4 Agicultural PFTs: present if they are prescribed
182    !
183
184    DO j = 2,nvm
185
186       IF ( .NOT. natural(j) ) THEN
187
188          IF (bavard.GE.4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
189
190          IF ( tree(j) ) THEN
191
192             !
193             ! 4.1 don't treat agricultural trees for the moment
194             !
195
196             WRITE(numout,*) 'pftinout: Agricultural trees not treated. We stop.'
197             STOP
198
199          ELSE
200
201             !
202             ! 4.2 grasses
203             !
204
205             DO i = 1, npts
206
207                IF ( ( veget_max(i,j) .GT. zero ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
208
209                   ! prescribed, but not yet there.
210
211                   ind(i,j) = veget_max(i,j)
212
213                   biomass(i,j,:) = bm_sapl(j,:) * ind(i,j) /veget_max(i,j) ! TL
214                   !NV passge 2D
215
216                   co2_to_bm(i,j) =  co2_to_bm(i,j) +SUM( biomass(i,j,:) ) / dt
217
218                   PFTpresent(i,j) = .TRUE.
219
220                   everywhere(i,j) = un
221
222                   senescence(i,j) = .FALSE.
223
224                   age(i,j) = zero
225
226                ENDIF  ! prescribed, but PFT not yet present
227
228             ENDDO    ! loop over grid points
229
230          ENDIF
231
232       ENDIF      ! not natural
233
234    ENDDO        ! loop over PFTs
235
236    !
237    ! 5 Eliminate PFTs
238    !
239
240    DO j = 2,nvm
241
242       ! only for natural PFTs
243
244       IF ( natural(j) ) THEN
245
246          WHERE (  PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
247
248             ! PFT there, but not adapted any more (ex: winter too cold): kill
249             ! set number of individuals to zero - rest will be done in lpj_kill
250
251             ind(:,j) = zero
252
253          ENDWHERE
254
255       ENDIF    ! natural
256
257    ENDDO       ! loop over PFTs
258
259    !
260    ! 6 Introduce PFTs
261    !
262
263    DO j = 2,nvm
264
265       IF ( natural(j) ) THEN
266
267          ! space availability for this PFT
268
269          IF ( tree(j) ) THEN
270             avail(:) = avail_tree(:)
271          ELSE
272             avail(:) = avail_grass(:)
273          ENDIF
274
275          !
276          ! 6.1 Check if PFT not present but (adapted and regenerative)
277          !
278
279          can_introduce(:) = .FALSE.
280
281          DO i = 1, npts
282
283             IF ( .NOT. PFTpresent(i,j) .AND. &
284                  ( adapted(i,j) .GT. adapted_crit ) .AND. &
285                  ( regenerate(i,j) .GT. regenerate_crit )  ) THEN
286
287                ! climate allows introduction
288
289                IF ( need_adjacent(i,j) ) THEN
290
291                   ! 6.1.1 climate allows introduction, but we need to look at the neighbours
292                   !       If the PFT has totally invaded at least one adjacent
293                   !       grid cell, it can be introduced.
294
295                   ! count number of totally invaded neighbours
296                   ! no loop so that it can vectorize
297
298                   n_present(i) = 0
299
300                   IF ( neighbours(i,1) .GT. 0 ) THEN
301                      IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
302                         n_present(i) = n_present(i)+1
303                      ENDIF
304                   ENDIF
305                   IF ( neighbours(i,3) .GT. 0 ) THEN
306                      IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
307                         n_present(i) = n_present(i)+1
308                      ENDIF
309                   ENDIF
310                   IF ( neighbours(i,5) .GT. 0 ) THEN
311                      IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
312                         n_present(i) = n_present(i)+1
313                      ENDIF
314                   ENDIF
315                   IF ( neighbours(i,7) .GT. 0 ) THEN
316                      IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
317                         n_present(i) = n_present(i)+1
318                      ENDIF
319                   ENDIF
320
321                   IF ( n_present(i) .GT. 0 ) THEN
322
323                      ! PFT is ubiquitious in at least one adjacent grid box
324                      can_introduce(i) = .TRUE.
325
326                   ENDIF
327
328                ELSE
329
330                   ! 6.1.2 we don't have to look at neighbours
331
332                   can_introduce(i) = .TRUE.
333
334                ENDIF   ! do we have to look at the neighbours?
335
336             ENDIF     ! we'd like to introduce the PFT
337
338          ENDDO       ! loop over grid points
339
340          !
341          ! 6.2 additionally test whether the PFT has been eliminated lately, i.e.
342          !     less than 1.25 years ago. Do not take full years as success of
343          !     introduction might depend on season.
344
345          WHERE ( RIP_time(:,j) .LT. RIP_time_min )
346
347             ! PFT was eliminated lately - cannot reintroduce
348
349             can_introduce(:) = .FALSE.
350
351          ENDWHERE
352
353          !
354          ! 6.3 Introduce that PFT where possible
355          !     "can_introduce" means that it either exists in neighbouring grid boxes
356          !     or that we do not look at neighbours, that it has not been eliminated
357          !     lately, and, of course, that the climate is good for that PFT.
358          !
359
360          WHERE ( can_introduce(:) )
361
362             PFTpresent(:,j) = .TRUE.
363
364             senescence(:,j) = .FALSE.
365
366             ! introduce at least a few saplings, even if canopy is closed
367
368             ind(:,j) = ind_0 * (dt/one_year) * avail(:)
369
370             WHERE(veget_max(:,j) .GT. zero)
371
372                biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j) /veget_max(:,j)
373                biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j) /veget_max(:,j)
374                biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)/veget_max(:,j)
375                biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)/veget_max(:,j)
376                biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)/veget_max(:,j)
377                biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)/veget_max(:,j)
378                biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)/veget_max(:,j)
379                biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)/veget_max(:,j)
380             ELSEWHERE
381
382                biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j)
383                biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j)
384                biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)
385                biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)
386                biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)
387                biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)
388                biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)
389                biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)
390             END WHERE
391             !NV passge 2D
392             co2_to_bm(:,j) = &
393                  co2_to_bm(:,j) / dt * &
394                  ( biomass(:,j,ileaf) + biomass(:,j,isapabove) + &
395                  biomass(:,j,isapbelow) + biomass(:,j,iheartabove) + &
396                  biomass(:,j,iheartbelow) + biomass(:,j,iroot) + &
397                  biomass(:,j,ifruit) + biomass(:,j,icarbres) )
398
399             when_growthinit(:,j) = large_value
400
401             age(:,j) = zero
402
403             ! all leaves are young
404             leaf_frac(:,j,1) = un
405
406             ! non-zero "long term" npp and last year's leaf mass for saplings -
407             !   so they won't be killed off by gap or kill
408
409             npp_longterm(:,j) = npp_longterm_init
410
411             lm_lastyearmax(:,j) = bm_sapl(j,ileaf) * ind(:,j)
412
413          ENDWHERE    ! we can introduce the PFT
414
415          !
416          ! 6.4 expansion of the PFT within the grid box (not to be confused with areal
417          !     coverage)
418          !
419
420          IF ( treat_expansion ) THEN
421
422             WHERE ( can_introduce(:) )
423                ! low value at the beginning
424                everywhere(:,j) = everywhere_init
425             ENDWHERE
426
427          ELSE
428
429             ! expansion is not treated
430
431             WHERE ( can_introduce(:) )
432                everywhere(:,j) = un
433             ENDWHERE
434
435          ENDIF   ! treat expansion
436
437       ENDIF     ! only natural PFTs
438
439    ENDDO       ! loop over PFTs
440
441    !
442    ! 7 If a PFT has been present once in a grid box, we suppose that it will survive
443    !   in isolated places (e.g., an oasis) within that grid box, even if it gets
444    !   officially eliminated from it later. That means that if climate becomes favorable
445    !   again, it will not need to get seeds from adjacent grid cells.
446    !
447
448    WHERE ( PFTpresent )
449       need_adjacent = .FALSE.
450    ENDWHERE
451
452    IF (bavard.GE.4) WRITE(numout,*) 'Leaving pftinout'
453
454  END SUBROUTINE pftinout
455
456END MODULE lpj_pftinout
Note: See TracBrowser for help on using the repository browser.