Context Navigation

source: tags/ORCHIDEE/src_stomate/stomate_turnover.f90 @ 6

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: