Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_litter.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: 22.7 KB

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

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

Download in other formats: