source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_turnover.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: 23.7 KB
Line 
1! This subroutine calculates:
2! 1-6 : leaf senescence, climatic and as a function of leaf age. New LAI.
3! 7 : herbivores
4! 8 : fruit turnover for trees.
5! 9 : sapwood conversion.
6!
7! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_turnover.f90,v 1.13 2010/04/06 15:44:01 ssipsl Exp $
8! IPSL (2006)
9!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
10!
11MODULE stomate_turnover
12
13  ! modules used:
14
15  USE ioipsl
16  USE stomate_data
17  USE constantes
18  USE pft_parameters
19
20  IMPLICIT NONE
21
22  ! private & public routines
23
24  PRIVATE
25  PUBLIC turn, turn_clear
26
27  ! first call
28  LOGICAL, SAVE                                              :: firstcall = .TRUE.
29
30CONTAINS
31
32  SUBROUTINE turn_clear
33    firstcall=.TRUE.
34  END SUBROUTINE turn_clear
35
36  SUBROUTINE turn (npts, dt, PFTpresent, &
37       herbivores, &
38       maxmoiavail_lastyear, minmoiavail_lastyear, &
39       moiavail_week, moiavail_month, tlong_ref, t2m_month, t2m_week, veget_max, &
40       leaf_age, leaf_frac, age, lai, biomass, &
41       turnover, senescence,turnover_time)
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 in days
52    REAL(r_std), INTENT(in)                                     :: dt
53    ! PFT exists
54    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent
55    ! time constant of probability of a leaf to be eaten by a herbivore (days)
56    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores
57    ! last year's maximum moisture availability
58    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear
59    ! last year's minimum moisture availability
60    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear
61    ! "weekly" moisture availability
62    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week
63    ! "monthly" moisture availability
64    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month
65    ! "long term" 2 meter reference temperatures (K)
66    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: tlong_ref
67    ! "monthly" 2-meter temperatures (K)
68    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: t2m_month
69    ! "weekly" 2 meter temperatures (K)
70    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: t2m_week
71    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
72    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
73
74    ! 0.2 modified fields
75
76    ! age of the leaves (days)
77    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age
78    ! fraction of leaves in leaf age class
79    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac
80    ! age (years)
81    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age
82    ! leaf area index
83    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lai
84    ! biomass (gC/(m**2 of ground))
85    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)     :: biomass
86    ! turnover_time  of grasse
87    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time
88
89    ! 0.3 output
90
91    ! Turnover rates (gC/day/(m**2 of ground))
92    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out)       :: turnover
93    ! is the plant senescent?
94    !   (interesting only for deciduous trees: carbohydrate reserve)
95    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                 :: senescence
96
97    ! 0.4 local
98
99!!$    ! minimum leaf age for senescence (d)
100!!$    REAL(r_std), PARAMETER                                      :: min_leaf_age = 30.
101    ! mean age of the leaves (days)
102    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_meanage
103    ! Intermediate variable for turnover
104    REAL(r_std), DIMENSION(npts)                                :: dturnover
105    ! critical moisture availability, function of last year's moisture availability
106    REAL(r_std), DIMENSION(npts)                                :: moiavail_crit
107    ! long term annual mean temperature, C
108    REAL(r_std), DIMENSION(npts)                                :: tl
109    ! critical senescence temperature, function of long term annual temperature (K)
110    REAL(r_std), DIMENSION(npts)                                :: t_crit
111    ! shed the remaining leaves?
112    LOGICAL, DIMENSION(npts)                                   :: shed_rest
113    ! Sapwood conversion (gC/day(m**2 of ground))
114    REAL(r_std), DIMENSION(npts)                                :: sapconv
115    ! old heartwood mass (gC/(m**2 of ground))
116    REAL(r_std), DIMENSION(npts)                                :: hw_old
117    ! new heartwood mass (gC/(m**2 of ground))
118    REAL(r_std), DIMENSION(npts)                                :: hw_new
119    ! old leaf mass (gC/(m**2 of ground))
120    REAL(r_std), DIMENSION(npts)                                :: lm_old
121    ! leaf mass change for each age class
122    REAL(r_std), DIMENSION(npts,nleafages)                      :: delta_lm
123    ! turnover rate
124    REAL(r_std), DIMENSION(npts)                                :: turnover_rate
125    ! critical leaf age (d)
126    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_crit
127    ! instantaneous turnover time
128    REAL(r_std), DIMENSION(npts,nvm)                           :: new_turnover_time
129    ! Index
130    INTEGER(i_std)                                             :: j,m
131
132    ! =========================================================================
133
134    IF (bavard.GE.3) WRITE(numout,*) 'Entering turnover'
135
136    !
137    ! 1 messages
138    !
139
140    IF ( firstcall ) THEN
141
142       WRITE(numout,*) 'turnover:'
143
144       WRITE(numout,*) ' > minimum mean leaf age for senescence (d): ',min_leaf_age_for_senescence
145
146       firstcall = .FALSE.
147
148
149    ENDIF
150
151    !
152    ! 2 Initializations
153    !
154
155    !
156    ! 2.1 set output to zero
157    !
158
159    turnover(:,:,:) = zero
160    new_turnover_time=zero
161    senescence(:,:) = .FALSE.
162
163    !
164    ! 2.2 mean leaf age. Should actually be recalculated at the end of this routine,
165    !     but it does not change too fast.
166    !
167
168    leaf_meanage(:,:) = 0.0
169
170    DO m = 1, nleafages
171       leaf_meanage(:,:) = leaf_meanage(:,:) + leaf_age(:,:,m) * leaf_frac(:,:,m)
172    ENDDO
173
174    !
175    ! 3 different types of "climatic" leaf senescence
176    !   does not change age structure.
177    !
178
179    DO j = 2,nvm
180
181       !
182       ! 3.1 determine if there is climatic senescence
183       !
184
185       SELECT CASE ( senescence_type(j) )
186
187       CASE ( 'cold' )
188
189          ! 3.1.1 summergreen species:
190          !       monthly temperature low and temperature tendency negative ?
191
192          ! critical temperature for senescence may depend on long term annual mean temperature
193          tl(:) = tlong_ref(:) - ZeroCelsius
194          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
195               tl(:) * senescence_temp(j,2) + &
196               tl(:)*tl(:) * senescence_temp(j,3)
197
198          WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. &
199               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
200               ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) )
201
202             senescence(:,j) = .TRUE.
203
204          ENDWHERE
205
206       CASE ( 'dry' )
207
208          ! 3.1.2 raingreen species:
209          !       does moisture availability drop below critical level?
210
211          moiavail_crit(:) = &
212               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
213               ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
214               senescence_hum(j) ), &
215               nosenescence_hum(j) )
216
217          WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. &
218               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
219               ( moiavail_week(:,j) .LT. moiavail_crit(:) ) )
220
221             senescence(:,j) = .TRUE.
222
223          ENDWHERE
224
225       CASE ( 'mixed' )
226
227          ! 3.1.3 mixed criterion:
228          !       moisture availability drops below critical level, or
229          !       monthly temperature low and temperature tendency negative
230          moiavail_crit(:) = &
231               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
232               ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
233               senescence_hum(j) ), &
234               nosenescence_hum(j) )
235          tl(:) = tlong_ref(:) - ZeroCelsius
236          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
237               tl(:) * senescence_temp(j,2) + &
238               tl(:)*tl(:) * senescence_temp(j,3)
239          IF ( tree(j) ) THEN
240
241             ! critical temperature for senescence may depend on long term annual mean temperature
242             WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. &
243                  ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
244                  ( ( moiavail_week(:,j) .LT. moiavail_crit(:) ) .OR. &
245                  ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) ) ) )
246                senescence(:,j) = .TRUE.
247             ENDWHERE
248          ELSE
249             new_turnover_time(:,j)=max_turnover_time(j)+ new_turnover_time_ref
250             WHERE ((moiavail_week(:,j) .LT. moiavail_month(:,j))&
251                  .AND. (moiavail_week(:,j) .LT. nosenescence_hum(j)))
252                new_turnover_time(:,j)=max_turnover_time(j) * &
253                     (1.-nosenescence_hum(j)+moiavail_week(:,j)) * &
254                     (1.-nosenescence_hum(j)+moiavail_week(:,j)) + &
255                     min_turnover_time(j)
256                !            new_turnover_time(:,j)=pheno_crit%max_turnover_time(j) * &
257                !                   moiavail_week(:,j)/ pheno_crit%nosenescence_hum(j) + &
258                !                   pheno_crit%min_turnover_time(j)
259             ENDWHERE
260             !         WHERE ((t2m_month(:) .LT. t_crit(:)+5) .AND. ( t2m_week(:) .LT. t2m_month(:) ))
261             !            new_turnover_time(:,j)=new_turnover_time(:,j)*((t2m_month(:)-t_crit(:))/5*0.4+0.6)
262             !         ENDWHERE
263             !         WHERE (new_turnover_time(:,j) .LT.  pheno_crit%min_turnover_time(j))
264             !            new_turnover_time(:,j)=pheno_crit%min_turnover_time(j)
265             !         ENDWHERE
266
267             WHERE (new_turnover_time(:,j) .GT. turnover_time(:,j)*1.1)
268                new_turnover_time(:,j)=max_turnover_time(j)+ new_turnover_time_ref
269             ENDWHERE
270!!$            WHERE  ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) &
271!!$                 &   .AND. ( leaf_meanage(:,j) .GT. pheno_crit%min_leaf_age_for_senescence(j) ))
272!!$              new_turnover_time(:,j)=pheno_crit%min_turnover_time(j)
273!!$            ENDWHERE
274             !           print *,'t_crit=',t_crit
275
276
277             turnover_time(:,j)=(turnover_time(:,j)*dt_turnover_time/dt+new_turnover_time(:,j))/(dt_turnover_time/dt+1.)
278
279          ENDIF
280
281       CASE ( 'none' )
282
283          ! evergreen species: no climatic senescence
284
285       CASE default
286
287          WRITE(numout,*) 'turnover: don''t know how to treat this PFT.'
288          WRITE(numout,*) '  number: ',j
289          WRITE(numout,*) '  senescence type: ',senescence_type(j)
290          STOP
291
292       END SELECT
293
294       !
295       ! 3.2 drop leaves and roots, plus stems and fruits for grasses
296       !
297
298       IF ( tree(j) ) THEN
299
300          ! 3.2.1 trees
301
302          WHERE ( senescence(:,j) )
303
304             turnover(:,j,ileaf) = biomass(:,j,ileaf) * dt / leaffall(j)
305             turnover(:,j,iroot) = biomass(:,j,iroot) * dt / leaffall(j)
306
307             biomass(:,j,ileaf) = biomass(:,j,ileaf) - turnover(:,j,ileaf)
308             biomass(:,j,iroot) = biomass(:,j,iroot) - turnover(:,j,iroot)
309
310          ENDWHERE
311
312       ELSE
313
314          ! 3.2.2 grasses     
315          WHERE (turnover_time(:,j) .LT. max_turnover_time(j)) 
316             turnover(:,j,ileaf) = biomass(:,j,ileaf) * dt / turnover_time(:,j)
317             turnover(:,j,isapabove) = biomass(:,j,isapabove) * dt / turnover_time(:,j)
318             turnover(:,j,iroot) = biomass(:,j,iroot) * dt / turnover_time(:,j) 
319             turnover(:,j,ifruit) = biomass(:,j,ifruit) * dt / turnover_time(:,j)
320          ELSEWHERE
321             turnover(:,j,ileaf)=0.0
322             turnover(:,j,isapabove) =0.0
323             turnover(:,j,iroot) = 0.0
324             turnover(:,j,ifruit) =0.0
325          ENDWHERE
326          biomass(:,j,ileaf) = biomass(:,j,ileaf) - turnover(:,j,ileaf)
327          biomass(:,j,isapabove) = biomass(:,j,isapabove) - turnover(:,j,isapabove)
328          biomass(:,j,iroot) = biomass(:,j,iroot) - turnover(:,j,iroot)
329          biomass(:,j,ifruit) = biomass(:,j,ifruit) - turnover(:,j,ifruit)
330
331       ENDIF      ! tree/grass
332
333    ENDDO        ! loop over PFTs
334
335    !
336    ! 4 At a certain age, leaves fall off, even if the climate would allow a green plant
337    !     all year round.
338    !   Decay rate varies with leaf age.
339    !   Roots, fruits (and stems) follow leaves.
340    !   Note that plant is not declared senescent in this case (important for allocation:
341    !   if the plant loses leaves because of their age, it can renew them).
342    !
343
344    DO j = 2,nvm
345
346       ! save old leaf mass
347       lm_old(:) = biomass(:,j,ileaf)
348
349       ! initialize leaf mass change in age class
350       delta_lm(:,:) = 0.0
351
352       IF ( tree(j) ) THEN
353
354          !
355          ! 4.1 trees: leaves, roots, fruits
356          !            roots and fruits follow leaves.
357          !
358
359          ! 4.1.1 critical age: prescribed for trees
360
361          leaf_age_crit(:,j) = leafagecrit(j)
362
363          ! 4.1.2 loop over leaf age classes
364
365          DO m = 1, nleafages
366             turnover_rate(:) =0 
367             WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. )
368
369                turnover_rate(:) =  &
370                     MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * &
371                     ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**quatre ) )
372
373                dturnover(:) = biomass(:,j,ileaf) * leaf_frac(:,j,m) * turnover_rate(:)
374                turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
375                biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
376
377                ! save leaf mass change
378                delta_lm(:,m) = - dturnover(:)
379
380                dturnover(:) = biomass(:,j,iroot) * leaf_frac(:,j,m) * turnover_rate(:)
381                turnover(:,j,iroot) = turnover(:,j,iroot) + dturnover(:)
382                biomass(:,j,iroot) = biomass(:,j,iroot) - dturnover(:)
383
384                dturnover(:) = biomass(:,j,ifruit) * leaf_frac(:,j,m) * turnover_rate(:)
385                turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
386                biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
387
388             ENDWHERE
389
390          ENDDO
391
392       ELSE
393
394          !
395          ! 4.2 grasses: leaves, roots, fruits, sap.
396          !              roots, fruits, and sap follow leaves.
397          !
398
399          ! 4.2.1 critical leaf age depends on long-term temperature:
400          !       generally, lower turnover in cooler climates.
401
402          leaf_age_crit(:,j) = &
403               MIN( leafagecrit(j) * leaf_age_crit_coeff(1) , &
404               MAX( leafagecrit(j) * leaf_age_crit_coeff(2) , &
405               leafagecrit(j) - leaf_age_crit_coeff(3) * &
406               ( tlong_ref(:)-ZeroCelsius - leaf_age_crit_tref ) ) )
407
408          ! 4.2.2 loop over leaf age classes
409
410          DO m = 1, nleafages
411
412             WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. )
413
414                turnover_rate(:) =  &
415                     MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * &
416                     ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**quatre ) )
417
418                dturnover(:) = biomass(:,j,ileaf) * leaf_frac(:,j,m) * turnover_rate(:)
419                turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
420                biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
421
422                ! save leaf mass change
423                delta_lm(:,m) = - dturnover(:)
424
425                dturnover(:) = biomass(:,j,isapabove) * leaf_frac(:,j,m) * turnover_rate(:)
426                turnover(:,j,isapabove) = turnover(:,j,isapabove) + dturnover(:)
427                biomass(:,j,isapabove) = biomass(:,j,isapabove) - dturnover(:)
428
429                dturnover(:) = biomass(:,j,iroot) * leaf_frac(:,j,m) * turnover_rate(:)
430                turnover(:,j,iroot) = turnover(:,j,iroot) + dturnover(:)
431                biomass(:,j,iroot) = biomass(:,j,iroot) - dturnover(:)
432
433                dturnover(:) = biomass(:,j,ifruit) * leaf_frac(:,j,m) * turnover_rate(:)
434                turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
435                biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
436
437             ENDWHERE
438
439
440          ENDDO
441
442       ENDIF       ! tree/grass ?
443
444       !
445       ! 4.3 recalculate fraction in each leaf age class
446       !     new fraction = new leaf mass of that fraction / new total leaf mass
447       !                  = ( old fraction*old total leaf mass + biomass change of that fraction ) /
448       !                    new total leaf mass
449       !
450
451       DO m = 1, nleafages
452
453          WHERE ( biomass(:,j,ileaf) .GT. 0.0 )
454             leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf)
455          ELSEWHERE
456             leaf_frac(:,j,m) = 0.0
457          ENDWHERE
458
459       ENDDO
460
461    ENDDO         ! loop over PFTs
462
463    !
464    ! 5 new (provisional) lai
465    !
466
467    !    lai(:,ibare_sechiba) = zero
468    !    DO j = 2, nvm
469    !        lai(:,j) = biomass(:,j,ileaf) * sla(j)
470    !    ENDDO
471
472    !
473    ! 6 definitely drop leaves if very low leaf mass during senescence.
474    !   Also drop fruits and loose fine roots.
475    !   Set lai to zero if necessary
476    !   Check whether leaf regrowth is immediately allowed.
477    !
478
479    DO j = 2,nvm
480
481       shed_rest(:) = .FALSE.
482
483       !
484       ! 6.1 deciduous trees
485       !
486
487       IF ( tree(j) .AND. ( senescence_type(j) .NE. 'none' ) ) THEN
488
489          ! check whether we shed the remaining leaves
490
491          WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. senescence(:,j) .AND. &
492               ( biomass(:,j,ileaf) .LT. (lai_initmin(j) / 2.)/sla(j) )             )
493
494             shed_rest(:) = .TRUE.
495
496             turnover(:,j,ileaf) = turnover(:,j,ileaf) + biomass(:,j,ileaf)
497             turnover(:,j,iroot) = turnover(:,j,iroot) + biomass(:,j,iroot)
498             turnover(:,j,ifruit) = turnover(:,j,ifruit) + biomass(:,j,ifruit)
499
500             biomass(:,j,ileaf) = 0.0
501             biomass(:,j,iroot) = 0.0
502             biomass(:,j,ifruit) = 0.0
503
504
505
506             ! reset leaf age
507             leaf_meanage(:,j) = 0.0
508
509          ENDWHERE
510
511       ENDIF
512
513       !
514       ! 6.2 grasses: also convert stems
515       !
516
517       IF ( .NOT. tree(j) ) THEN
518
519          ! Shed the remaining leaves if LAI very low.
520
521          WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. senescence(:,j) .AND. &
522               (  biomass(:,j,ileaf) .LT. (lai_initmin(j) / 2.)/sla(j) ))
523
524             shed_rest(:) = .TRUE.
525
526             turnover(:,j,ileaf) = turnover(:,j,ileaf) + biomass(:,j,ileaf)
527             turnover(:,j,isapabove) = turnover(:,j,isapabove) + biomass(:,j,isapabove)
528             turnover(:,j,iroot) = turnover(:,j,iroot) + biomass(:,j,iroot)
529             turnover(:,j,ifruit) = turnover(:,j,ifruit) + biomass(:,j,ifruit)
530
531             biomass(:,j,ileaf) = 0.0
532             biomass(:,j,isapabove) = 0.0
533             biomass(:,j,iroot) = 0.0
534             biomass(:,j,ifruit) = 0.0
535
536
537
538             ! reset leaf age
539             leaf_meanage(:,j) = 0.0
540
541          ENDWHERE
542
543       ENDIF
544
545       !
546       ! 6.3 reset leaf age structure
547       !
548
549       DO m = 1, nleafages
550
551          WHERE ( shed_rest(:) )
552
553             leaf_age(:,j,m) = 0.0
554             leaf_frac(:,j,m) = 0.0
555
556          ENDWHERE
557
558       ENDDO
559
560    ENDDO
561
562    !
563    ! 7 Elephants, cows, gazelles. No lions.
564    !   Does not modify leaf age structure.
565    !
566
567    IF ( ok_herbivores ) THEN
568
569       ! herbivore activity allowed. Eat when there are leaves. Otherwise,
570       ! there won't be many fruits anyway.
571
572       DO j = 2,nvm
573
574          IF ( tree(j) ) THEN
575
576             ! trees: only leaves and fruits are affected
577
578             WHERE ( biomass(:,j,ileaf) .GT. zero )
579                ! added by shilong
580                WHERE (herbivores(:,j).GT. zero)
581                   dturnover(:) = biomass(:,j,ileaf) * dt / herbivores(:,j)
582                   turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
583                   biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
584
585                   dturnover(:) = biomass(:,j,ifruit) * dt / herbivores(:,j)
586                   turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
587                   biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
588                ENDWHERE
589             ENDWHERE
590
591          ELSE
592
593             ! grasses: the whole biomass above the ground: leaves, fruits, stems
594
595             WHERE ( biomass(:,j,ileaf) .GT. zero )
596                ! added by shilong
597                WHERE (herbivores(:,j) .GT. zero)
598                   dturnover(:) = biomass(:,j,ileaf) * dt / herbivores(:,j)
599                   turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
600                   biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
601
602                   dturnover(:) = biomass(:,j,isapabove) * dt / herbivores(:,j)
603                   turnover(:,j,isapabove) = turnover(:,j,isapabove) + dturnover(:)
604                   biomass(:,j,isapabove) = biomass(:,j,isapabove) - dturnover(:)
605
606                   dturnover(:) = biomass(:,j,ifruit) * dt / herbivores(:,j)
607                   turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
608                   biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
609                ENDWHERE
610
611             ENDWHERE
612
613          ENDIF  ! tree/grass?
614
615       ENDDO    ! loop over PFTs
616
617    ENDIF
618
619    !
620    ! 8 fruit turnover for trees
621    !
622
623    DO j = 2,nvm
624
625       IF ( tree(j) ) THEN
626
627          !SZ correction of a mass destroying bug
628          dturnover(:) = biomass(:,j,ifruit) * dt / tau_fruit(j)
629          turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
630          biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
631!!$        turnover(:,j,ifruit) = biomass(:,j,ifruit) * dt / tau_fruit(j)
632!!$        biomass(:,j,ifruit) = biomass(:,j,ifruit) - turnover(:,j,ifruit)
633
634       ENDIF
635
636    ENDDO
637
638    !
639    ! 9 Conversion of sapwood to heartwood
640    !   This is not added to "turnover" as the biomass is not lost!
641    !
642
643    DO j = 2,nvm
644
645       IF ( tree(j) ) THEN
646
647          ! for age calculations
648
649          IF ( .NOT. control%ok_dgvm ) THEN
650             hw_old(:) = biomass(:,j,iheartabove) + biomass(:,j,iheartbelow)
651          ENDIF
652
653          !
654          ! 9.1 Calculate the rate of conversion and update masses
655          !
656
657          ! above the ground
658
659          sapconv(:) = biomass(:,j,isapabove) * dt / tau_sap(j)
660          biomass(:,j,isapabove) = biomass(:,j,isapabove) - sapconv(:)
661          biomass(:,j,iheartabove) =  biomass(:,j,iheartabove) + sapconv(:)
662
663          ! below the ground
664
665          sapconv(:) = biomass(:,j,isapbelow) * dt / tau_sap(j)
666          biomass(:,j,isapbelow) = biomass(:,j,isapbelow) - sapconv(:)
667          biomass(:,j,iheartbelow) =  biomass(:,j,iheartbelow) + sapconv(:)
668
669
670          !
671          ! 9.2 If vegetation is not dynamic, identify the age of the heartwood
672          !     to the age of the whole tree (otherwise, the age of the tree is
673          !     treated in the establishment routine).
674          !     Creation of new heartwood decreases the age of the plant.
675          !
676
677          IF ( .NOT. control%ok_dgvm ) THEN
678
679             hw_new(:) = biomass(:,j,iheartabove) + biomass(:,j,iheartbelow)
680
681             WHERE ( hw_new(:) .GT. 0.0 )
682
683                age(:,j) = age(:,j) * hw_old(:)/hw_new(:)
684
685             ENDWHERE
686
687          ENDIF
688
689       ENDIF
690
691    ENDDO
692
693    !
694    ! history
695    !
696
697    CALL histwrite (hist_id_stomate, 'LEAF_AGE', itime, &
698         leaf_meanage, npts*nvm, horipft_index)
699    CALL histwrite (hist_id_stomate, 'HERBIVORES', itime, &
700         herbivores, npts*nvm, horipft_index)
701
702    IF (bavard.GE.4) WRITE(numout,*) 'Leaving turnover'
703
704  END SUBROUTINE turn
705
706END MODULE stomate_turnover
Note: See TracBrowser for help on using the repository browser.