Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_litter.f90

Last change on this file 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: 22.6 KB

Line
1	! Update litter and lignine content after litter fall.
2	! Calculate litter decomposition.
3	!
4	!< $HeadURL$
5	!< $Date$
6	!< $Author$
7	!< $Revision$
8	! IPSL (2006)
9	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
10	!
11	MODULE stomate_litter
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 littercalc,littercalc_clear, deadleaf
26
27	! first call
28	LOGICAL, SAVE :: firstcall = .TRUE.
29
30
31	CONTAINS
32
33	SUBROUTINE littercalc_clear
34	firstcall =.TRUE.
35	END SUBROUTINE littercalc_clear
36
37
38	SUBROUTINE littercalc (npts, dt, &
39	turnover, bm_to_litter, &
40	veget_max, tsurf, tsoil, soilhum, litterhum, &
41	litterpart, litter, dead_leaves, lignin_struc, &
42	deadleaf_cover, resp_hetero_litter, &
43	soilcarbon_input, control_temp, control_moist)
44
45	!
46	! 0 declarations
47	!
48
49	! 0.1 input
50
51	! Domain size
52	INTEGER(i_std), INTENT(in) :: npts
53	! time step in days
54	REAL(r_std), INTENT(in) :: dt
55	! Turnover rates (gC/(m**2 of ground)/day)
56	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: turnover
57	! conversion of biomass to litter (gC/(m**2 of ground)) / day
58	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: bm_to_litter
59	! veget_max
60	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_max
61	! temperature (K) at the surface
62	REAL(r_std), DIMENSION(npts), INTENT(in) :: tsurf
63	! soil temperature (K)
64	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil
65	! daily soil humidity
66	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum
67	! daily litter humidity
68	REAL(r_std), DIMENSION(npts), INTENT(in) :: litterhum
69
70	! 0.2 modified fields
71
72	! fraction of litter above the ground belonging to different PFTs
73	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout) :: litterpart
74	! metabolic and structural litter,above and below ground (gC/m**2 of ground)
75	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs), INTENT(inout) :: litter
76	! dead leaves on ground, per PFT, metabolic and structural,
77	! in gC/(m**2 of ground)
78	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout) :: dead_leaves
79	! ratio Lignine/Carbon in structural litter, above and below ground, (gC/m**2)
80	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout) :: lignin_struc
81
82	! 0.3 output
83
84	! fraction of soil covered by dead leaves
85	REAL(r_std), DIMENSION(npts), INTENT(out) :: deadleaf_cover
86	! litter heterotrophic respiration (in gC/day/m**2 of ground)
87	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_hetero_litter
88	! quantity of carbon going into carbon pools from litter decomposition
89	! (gC/(m**2 of ground)/day)
90	REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(out) :: soilcarbon_input
91	! temperature control of heterotrophic respiration, above and below
92	REAL(r_std), DIMENSION(npts,nlevs), INTENT(out) :: control_temp
93	! moisture control of heterotrophic respiration
94	REAL(r_std), DIMENSION(npts,nlevs), INTENT(out) :: control_moist
95
96	! 0.4 local
97
98	! what fraction of leaves, wood, etc. goes into metabolic and structural litterpools
99	REAL(r_std), SAVE, DIMENSION(nparts,nlitt) :: litterfrac
100	! soil levels (m)
101	REAL(r_std), SAVE, DIMENSION(0:nbdl) :: z_soil
102	! integration constant for vertical profiles
103	REAL(r_std), DIMENSION(npts) :: rpc
104	! residence time in litter pools (days)
105	REAL(r_std), SAVE, DIMENSION(nlitt) :: litter_tau
106	! decomposition flux fraction that goes into soil (litter -> carbon, above and below)
107	! rest goes into atmosphere
108	REAL(r_std), SAVE, DIMENSION(nlitt,ncarb,nlevs) :: frac_soil
109	! temperature used for decompostition in soil (K)
110	REAL(r_std), DIMENSION(npts) :: tsoil_decomp
111	! humidity used for decompostition in soil
112	REAL(r_std), DIMENSION(npts) :: soilhum_decomp
113	! fraction of structural or metabolic litter decomposed
114	REAL(r_std), DIMENSION(npts) :: fd
115	! quantity of structural or metabolic litter decomposed (gC/m**2)
116	REAL(r_std), DIMENSION(npts) :: qd
117	! old structural litter, above and below (gC/m**2)
118	REAL(r_std), DIMENSION(npts,nvm,nlevs) :: old_struc
119	! increase of litter, per PFT, metabolic and structural,
120	! above and below ground (gC/m**2 of ground)
121	REAL(r_std), DIMENSION(npts,nvm,nlitt,nlevs) :: litter_inc_PFT
122	! increase of metabolic and structural litter, above and below ground (gC/m**2 of ground)
123	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs) :: litter_inc
124	! lignin increase in structural litter, above and below ground (gC/m**2 of ground)
125	REAL(r_std), DIMENSION(npts,nvm,nlevs) :: lignin_struc_inc
126	! metabolic and structural litter above the ground per PFT
127	REAL(r_std), DIMENSION(npts,nvm,nlitt) :: litter_pft
128	! intermediate array for looking for minimum
129	REAL(r_std), DIMENSION(npts) :: zdiff_min
130	! for messages
131	CHARACTER(LEN=10), DIMENSION(nlitt) :: litter_str
132	CHARACTER(LEN=22), DIMENSION(nparts) :: part_str
133	CHARACTER(LEN=7), DIMENSION(ncarb) :: carbon_str
134	CHARACTER(LEN=5), DIMENSION(nlevs) :: level_str
135	! Indices
136	INTEGER(i_std) :: i,j,k,l,m
137
138	! =========================================================================
139
140	IF (bavard.GE.3) WRITE(numout,*) 'Entering littercalc'
141
142	!
143	! 1 Initialisations
144	!
145
146	IF ( firstcall ) THEN
147
148	!
149	! 1.1 get soil "constants"
150	!
151
152	! 1.1.1 litter fractions:
153	! what fraction of leaves, wood, etc. goes into metabolic and structural litterpools
154
155	DO k = 1, nparts
156
157	litterfrac(k,imetabolic) = metabolic_ref_frac - metabolic_LN_ratio * LC(k) * CN(k)
158	litterfrac(k,istructural) = un - litterfrac(k,imetabolic)
159
160	ENDDO
161
162	! 1.1.2 residence times in litter pools (days)
163
164	litter_tau(imetabolic) = tau_metabolic * one_year !!!!???? .5 years
165	litter_tau(istructural) = tau_struct * one_year !!!!???? 3 years
166
167
168	! 1.1.3 decomposition flux fraction that goes into soil
169	! (litter -> carbon, above and below)
170	! 1-frac_soil goes into atmosphere
171
172	frac_soil(:,:,:) = zero
173
174	! structural litter: lignin fraction goes into slow pool + respiration,
175	! rest into active pool + respiration
176	frac_soil(istructural,iactive,iabove) = frac_soil_struct_aa
177	frac_soil(istructural,iactive,ibelow) = frac_soil_struct_ab
178	frac_soil(istructural,islow,iabove) = frac_soil_struct_sa
179	frac_soil(istructural,islow,ibelow) = frac_soil_struct_sb
180
181	! metabolic litter: all goes into active pool + respiration.
182	! Nothing into slow or passive pool.
183	frac_soil(imetabolic,iactive,iabove) = frac_soil_metab_aa
184	frac_soil(imetabolic,iactive,ibelow) = frac_soil_metab_ab
185
186	!
187	! 1.2 soil levels
188	!
189
190	z_soil(0) = zero
191	z_soil(1:nbdl) = diaglev(1:nbdl)
192
193	!
194	! 1.3 messages
195	!
196
197	litter_str(imetabolic) = 'metabolic'
198	litter_str(istructural) = 'structural'
199
200	carbon_str(iactive) = 'active'
201	carbon_str(islow) = 'slow'
202	carbon_str(ipassive) = 'passive'
203
204	level_str(iabove) = 'above'
205	level_str(ibelow) = 'below'
206
207	part_str(ileaf) = 'leaves'
208	part_str(isapabove) = 'sap above ground'
209	part_str(isapbelow) = 'sap below ground'
210	part_str(iheartabove) = 'heartwood above ground'
211	part_str(iheartbelow) = 'heartwood below ground'
212	part_str(iroot) = 'roots'
213	part_str(ifruit) = 'fruits'
214	part_str(icarbres) = 'carbohydrate reserve'
215
216	WRITE(numout,*) 'litter:'
217
218	WRITE(numout,*) ' > C/N ratios: '
219	DO k = 1, nparts
220	WRITE(numout,*) ' ', part_str(k), ': ',CN(k)
221	ENDDO
222
223	WRITE(numout,*) ' > Lignine/C ratios: '
224	DO k = 1, nparts
225	WRITE(numout,*) ' ', part_str(k), ': ',LC(k)
226	ENDDO
227
228	WRITE(numout,*) ' > fraction of compartment that goes into litter: '
229	DO k = 1, nparts
230	DO m = 1, nlitt
231	WRITE(numout,*) ' ', part_str(k), '-> ',litter_str(m), ':',litterfrac(k,m)
232	ENDDO
233	ENDDO
234
235	WRITE(numout,*) ' > scaling depth for decomposition (m): ',z_decomp
236
237	WRITE(numout,*) ' > minimal carbon residence time in litter pools (d):'
238	DO m = 1, nlitt
239	WRITE(numout,*) ' ',litter_str(m),':',litter_tau(m)
240	ENDDO
241
242	WRITE(numout,*) ' > litter decomposition flux fraction that really goes '
243	WRITE(numout,*) ' into carbon pools (rest into the atmosphere):'
244	DO m = 1, nlitt
245	DO l = 1, nlevs
246	DO k = 1, ncarb
247	WRITE(numout,*) ' ',litter_str(m),' ',level_str(l),' -> ',&
248	carbon_str(k),':', frac_soil(m,k,l)
249	ENDDO
250	ENDDO
251	ENDDO
252
253	firstcall = .FALSE.
254
255	ENDIF
256
257	!
258	! 1.3 litter above the ground per PFT.
259	!
260
261	DO j = 2, nvm
262
263	DO k = 1, nlitt
264	litter_pft(:,j,k) = litterpart(:,j,k) * litter(:,k,j,iabove)
265	ENDDO
266
267	ENDDO
268
269	!
270	! 1.4 set output to zero
271	!
272
273	deadleaf_cover(:) = zero
274	resp_hetero_litter(:,:) = zero
275	soilcarbon_input(:,:,:) = zero
276
277	!
278	! 2 Add biomass to different litterpools (per m**2 of ground)
279	!
280
281	!
282	! 2.1 first, save old structural litter (needed for lignin fractions).
283	! above/below
284	!
285
286	DO l = 1, nlevs
287	DO m = 2,nvm
288
289	old_struc(:,m,l) = litter(:,istructural,m,l)
290
291	ENDDO
292	ENDDO
293
294	!
295	! 2.2 update litter, dead leaves, and lignin content in structural litter
296	!
297
298	litter_inc(:,:,:,:) = zero
299	lignin_struc_inc(:,:,:) = zero
300
301	DO j = 2,nvm
302
303	! 2.2.1 litter
304
305	DO k = 1, nlitt ! metabolic and structural
306
307	! 2.2.2 calculate litter increase (per m**2 of ground).
308	! Only a given fracion of fruit turnover is directly coverted into litter.
309	! Litter increase for each PFT, structural and metabolic, above/below
310
311	litter_inc_PFT(:,j,k,iabove) = &
312	litterfrac(ileaf,k) * bm_to_litter(:,j,ileaf) + &
313	litterfrac(isapabove,k) * bm_to_litter(:,j,isapabove) + &
314	litterfrac(iheartabove,k) * bm_to_litter(:,j,iheartabove) + &
315	litterfrac(ifruit,k) * bm_to_litter(:,j,ifruit) + &
316	litterfrac(icarbres,k) * bm_to_litter(:,j,icarbres) + &
317	litterfrac(ileaf,k) * turnover(:,j,ileaf) + &
318	litterfrac(isapabove,k) * turnover(:,j,isapabove) + &
319	litterfrac(iheartabove,k) * turnover(:,j,iheartabove) + &
320	litterfrac(ifruit,k) * turnover(:,j,ifruit) + &
321	litterfrac(icarbres,k) * turnover(:,j,icarbres)
322
323	litter_inc_PFT(:,j,k,ibelow) = &
324	litterfrac(isapbelow,k) * bm_to_litter(:,j,isapbelow) + &
325	litterfrac(iheartbelow,k) * bm_to_litter(:,j,iheartbelow) + &
326	litterfrac(iroot,k) * bm_to_litter(:,j,iroot) + &
327	litterfrac(isapbelow,k) * turnover(:,j,isapbelow) + &
328	litterfrac(iheartbelow,k) * turnover(:,j,iheartbelow) + &
329	litterfrac(iroot,k) * turnover(:,j,iroot)
330
331	! litter increase, met/struct, above/below
332
333	litter_inc(:,k,j,iabove) = litter_inc(:,k,j,iabove) + litter_inc_PFT(:,j,k,iabove)
334	litter_inc(:,k,j,ibelow) = litter_inc(:,k,j,ibelow) + litter_inc_PFT(:,j,k,ibelow)
335
336	! 2.2.3 dead leaves, for soil cover.
337
338	dead_leaves(:,j,k) = &
339	dead_leaves(:,j,k) + &
340	litterfrac(ileaf,k) * ( bm_to_litter(:,j,ileaf) + turnover(:,j,ileaf) )
341
342	! 2.2.4 lignin increase in structural litter
343
344	IF ( k .EQ. istructural ) THEN
345
346	lignin_struc_inc(:,j,iabove) = &
347	lignin_struc_inc(:,j,iabove) + &
348	LC(ileaf) * bm_to_litter(:,j,ileaf) + &
349	LC(isapabove) * bm_to_litter(:,j,isapabove) + &
350	LC(iheartabove) * bm_to_litter(:,j,iheartabove) + &
351	LC(ifruit) * bm_to_litter(:,j,ifruit) + &
352	LC(icarbres) * bm_to_litter(:,j,icarbres) + &
353	LC(ileaf) * turnover(:,j,ileaf) + &
354	LC(isapabove) * turnover(:,j,isapabove) + &
355	LC(iheartabove) * turnover(:,j,iheartabove) + &
356	LC(ifruit) * turnover(:,j,ifruit) + &
357	LC(icarbres) * turnover(:,j,icarbres)
358
359	lignin_struc_inc(:,j,ibelow) = &
360	lignin_struc_inc(:,j,ibelow) + &
361	LC(isapbelow) * bm_to_litter(:,j,isapbelow) + &
362	LC(iheartbelow) * bm_to_litter(:,j,iheartbelow) + &
363	LC(iroot) * bm_to_litter(:,j,iroot) + &
364	LC(isapbelow)*turnover(:,j,isapbelow) + &
365	LC(iheartbelow)*turnover(:,j,iheartbelow) + &
366	LC(iroot)*turnover(:,j,iroot)
367
368	ENDIF
369
370	ENDDO
371	ENDDO
372
373	! 3.2.5 add new litter (struct/met, above/below)
374
375	litter(:,:,:,:) = litter(:,:,:,:) + litter_inc(:,:,:,:)
376
377	! 3.2.6 for security: can't add more lignin than structural litter (above/below)
378
379	DO l = 1, nlevs
380	DO m = 2,nvm
381
382	lignin_struc_inc(:,m,l) = &
383	MIN( lignin_struc_inc(:,m,l), litter_inc(:,istructural,m,l) )
384
385	ENDDO
386	ENDDO
387
388	! 3.2.7 new lignin content: add old lignin and lignin increase, divide by
389	! total structural litter (above/below)
390
391	DO l = 1, nlevs
392	DO m = 2,nvm
393	WHERE( litter(:,istructural,m,l) .GT. min_stomate )
394
395	!MM : Soenke modif
396	! Best vectorization ?
397	!!$ lignin_struc(:,:,:) = &
398	!!$ ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:) ) / &
399	!!$ litter(:,istructural,:,:,icarbon)
400
401	lignin_struc(:,m,l) = lignin_struc(:,m,l) * old_struc(:,m,l)
402	lignin_struc(:,m,l) = lignin_struc(:,m,l) + lignin_struc_inc(:,m,l)
403	lignin_struc(:,m,l) = lignin_struc(:,m,l) / litter(:,istructural,m,l)
404	ELSEWHERE
405	lignin_struc(:,m,l) = zero
406	ENDWHERE
407	ENDDO
408	ENDDO
409
410	!
411	! 3.3 new litter fraction per PFT (for structural and metabolic litter, above
412	! the ground).
413	!
414
415	DO j = 2,nvm
416
417	WHERE ( litter(:,:,j,iabove) .GT. min_stomate )
418
419	litterpart(:,j,:) = &
420	( litter_pft(:,j,:) + litter_inc_PFT(:,j,:,iabove) ) / litter(:,:,j,iabove)
421
422	ELSEWHERE
423
424	litterpart(:,j,:) = zero
425
426	ENDWHERE
427
428	ENDDO
429
430	!
431	! 4 Temperature control on decay: Factor between 0 and 1
432	!
433
434	!
435	! 4.1 above: surface temperature
436	!
437
438	control_temp(:,iabove) = control_temp_func (npts, tsurf)
439
440	!
441	! 4.2 below: convolution of temperature and decomposer profiles
442	! (exponential decomposer profile supposed)
443	!
444
445	! 4.2.1 rpc is an integration constant such that the integral of the root profile is 1.
446	rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_decomp ) )
447
448	! 4.2.2 integrate over the nbdl levels
449
450	tsoil_decomp(:) = zero
451
452	DO l = 1, nbdl
453
454	tsoil_decomp(:) = &
455	tsoil_decomp(:) + tsoil(:,l) * rpc(:) * &
456	( EXP( -z_soil(l-1)/z_decomp ) - EXP( -z_soil(l)/z_decomp ) )
457
458	ENDDO
459
460	control_temp(:,ibelow) = control_temp_func (npts, tsoil_decomp)
461
462	!
463	! 5 Moisture control. Factor between 0 and 1
464	!
465
466	!
467	! 5.1 above the ground: litter humidity
468	!
469
470	control_moist(:,iabove) = control_moist_func (npts, litterhum)
471
472	!
473	! 5.2 below: convolution of humidity and decomposer profiles
474	! (exponential decomposer profile supposed)
475	!
476
477	! 5.2.1 rpc is an integration constant such that the integral of the root profile is 1.
478	rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_decomp ) )
479
480	! 5.2.2 integrate over the nbdl levels
481
482	soilhum_decomp(:) = zero
483
484	DO l = 1, nbdl
485
486	soilhum_decomp(:) = &
487	soilhum_decomp(:) + soilhum(:,l) * rpc(:) * &
488	( EXP( -z_soil(l-1)/z_decomp ) - EXP( -z_soil(l)/z_decomp ) )
489
490	ENDDO
491
492	control_moist(:,ibelow) = control_moist_func (npts, soilhum_decomp)
493
494	!
495	! 6 fluxes from litter to carbon pools and respiration
496	!
497
498	DO l = 1, nlevs
499	DO m = 2,nvm
500
501	!
502	! 6.1 structural litter: goes into active and slow carbon pools + respiration
503	!
504
505	! 6.1.1 total quantity of structural litter which is decomposed
506
507	fd(:) = dt/litter_tau(istructural) * &
508	control_temp(:,l) * control_moist(:,l) * exp( -litter_struct_coef * lignin_struc(:,m,l) )
509
510	qd(:) = litter(:,istructural,m,l) * fd(:)
511
512	litter(:,istructural,m,l) = litter(:,istructural,m,l) - qd(:)
513
514	! 6.1.2 decompose same fraction of structural part of dead leaves. Not exact
515	! as lignine content is not the same as that of the total structural litter.
516
517	! to avoid a multiple (for ibelow and iabove) modification of dead_leaves,
518	! we do this test to do this calcul only ones in 1,nlev loop
519	if (l == iabove) dead_leaves(:,m,istructural) = dead_leaves(:,m,istructural) * ( un - fd(:) )
520
521	! 6.1.3 non-lignin fraction of structural litter goes into
522	! active carbon pool + respiration
523
524	soilcarbon_input(:,iactive,m) = soilcarbon_input(:,iactive,m) + &
525	frac_soil(istructural,iactive,l) * qd(:) * ( 1. - lignin_struc(:,m,l) ) / dt
526
527	resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
528	( 1. - frac_soil(istructural,iactive,l) ) * qd(:) * &
529	( 1. - lignin_struc(:,m,l) ) / dt
530
531	! 6.1.4 lignin fraction of structural litter goes into
532	! slow carbon pool + respiration
533
534	soilcarbon_input(:,islow,m) = soilcarbon_input(:,islow,m) + &
535	frac_soil(istructural,islow,l) * qd(:) * lignin_struc(:,m,l) / dt
536
537	resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
538	( 1. - frac_soil(istructural,islow,l) ) * qd(:) * lignin_struc(:,m,l) / dt
539
540	!
541	! 6.2 metabolic litter goes into active carbon pool + respiration
542	!
543
544	! 6.2.1 total quantity of metabolic litter that is decomposed
545
546	fd(:) = dt/litter_tau(imetabolic) * control_temp(:,l) * control_moist(:,l)
547
548	qd(:) = litter(:,imetabolic,m,l) * fd(:)
549
550	litter(:,imetabolic,m,l) = litter(:,imetabolic,m,l) - qd(:)
551
552	! 6.2.2 decompose same fraction of metabolic part of dead leaves.
553
554	! to avoid a multiple (for ibelow and iabove) modification of dead_leaves,
555	! we do this test to do this calcul only ones in 1,nlev loop
556	if (l == iabove) dead_leaves(:,m,imetabolic) = dead_leaves(:,m,imetabolic) * ( 1. - fd(:) )
557
558
559	! 6.2.3 put decomposed litter into carbon pool + respiration
560
561	soilcarbon_input(:,iactive,m) = soilcarbon_input(:,iactive,m) + &
562	frac_soil(imetabolic,iactive,l) * qd(:) / dt
563
564	resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
565	( 1. - frac_soil(imetabolic,iactive,l) ) * qd(:) / dt
566
567	ENDDO
568	ENDDO
569
570	!
571	! 7 calculate fraction of total soil covered by dead leaves
572	!
573
574	CALL deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
575
576	IF (bavard.GE.4) WRITE(numout,*) 'Leaving littercalc'
577
578	END SUBROUTINE littercalc
579
580	SUBROUTINE deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
581
582	!
583	! 0 declarations
584	!
585
586	! 0.1 input
587
588	! Domain size
589	INTEGER(i_std), INTENT(in) :: npts
590	! dead leaves on ground, per PFT, metabolic and structural,
591	! in gC/(m**2 of ground)
592	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in) :: dead_leaves
593	!veget_max
594	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_max
595	! 0.2. output
596	! fraction of soil covered by dead leaves
597	REAL(r_std), DIMENSION(npts), INTENT(out) :: deadleaf_cover
598
599	! 0.3. local
600
601	! LAI of dead leaves
602	REAL(r_std), DIMENSION(npts) :: dead_lai
603	! Index
604	INTEGER(i_std) :: j
605
606	!
607	! 1 LAI of dead leaves
608	!
609
610	dead_lai(:) = zero
611
612	DO j = 2,nvm
613	dead_lai(:) = dead_lai(:) + ( dead_leaves(:,j,imetabolic) + dead_leaves(:,j,istructural) ) * sla(j) &
614	* veget_max(:,j)
615	ENDDO
616
617	!
618	! 2 fraction of soil covered by dead leaves
619	!
620
621	deadleaf_cover(:) = un - exp( - 0.5 * dead_lai(:) )
622
623	IF (bavard.GE.4) WRITE(numout,*) 'Leaving deadleaf'
624
625	END SUBROUTINE deadleaf
626
627	FUNCTION control_moist_func (npts, moist_in) RESULT (moistfunc_result)
628
629	!
630	! 0 declarations
631	!
632
633	! 0.1 input
634
635	! Domain size
636	INTEGER(i_std), INTENT(in) :: npts
637	! relative humidity
638	REAL(r_std), DIMENSION(npts), INTENT(in) :: moist_in
639
640	! 0.2 result
641
642	! moisture control factor
643	REAL(r_std), DIMENSION(npts) :: moistfunc_result
644
645	moistfunc_result(:) = -moist_coeff(1) * moist_in(:) * moist_in(:) + moist_coeff(2)* moist_in(:) - moist_coeff(3)
646	moistfunc_result(:) = MAX( 0.25_r_std, MIN( un, moistfunc_result(:) ) )
647
648	END FUNCTION control_moist_func
649
650	FUNCTION control_temp_func (npts, temp_in) RESULT (tempfunc_result)
651
652	!
653	! 0 declarations
654	!
655
656	! 0.1 input
657
658	! Domain size
659	INTEGER(i_std), INTENT(in) :: npts
660	! temperature (K)
661	REAL(r_std), DIMENSION(npts), INTENT(in) :: temp_in
662
663	! 0.2 result
664
665	! temperature control factor
666	REAL(r_std), DIMENSION(npts) :: tempfunc_result
667
668
669	tempfunc_result(:) = exp( soil_Q10 * ( temp_in(:) - (ZeroCelsius+tsoil_ref)) / Q10 )
670	tempfunc_result(:) = MIN( un, tempfunc_result(:) )
671
672	END FUNCTION control_temp_func
673
674	END MODULE stomate_litter

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

Download in other formats: