Context Navigation

source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/lpj_light.f90 @ 5816

Last change on this file since 5816 was 5816, checked in by jinfeng.chang, 5 years ago
copy ORCHIDEE-GMv3.2 for publication
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 26.7 KB

Line
1	! =================================================================================================================================
2	! MODULE : lpj_light
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF Light competition within a PFT
10	!!
11	!!\n DESCRIPTION: None
12	!!
13	!! RECENT CHANGE(S): None
14	!!
15	!! REFERENCE(S) :
16	!!
17	!! SVN :
18	!! $HeadURL$
19	!! $Date$
20	!! $Revision$
21	!! \n
22	!_ ================================================================================================================================
23
24	MODULE lpj_light
25
26	! modules used:
27	USE xios_orchidee
28	USE ioipsl_para
29	USE constantes
30	USE stomate_data
31
32	IMPLICIT NONE
33
34	! private & public routines
35
36	PRIVATE
37	PUBLIC light, light_clear
38
39	LOGICAL, SAVE :: firstcall_light = .TRUE. !! first call
40	!$OMP THREADPRIVATE(firstcall_light)
41
42	CONTAINS
43
44	!! ================================================================================================================================
45	!! SUBROUTINE : light_clear
46	!!
47	!>\BRIEF Activation
48	!!
49	!_ ================================================================================================================================
50
51	SUBROUTINE light_clear
52	firstcall_light=.TRUE.
53	END SUBROUTINE light_clear
54
55
56	!! ================================================================================================================================
57	!! SUBROUTINE : light
58	!!
59	!>\BRIEF Light competition within a PFT
60	!!
61	!! DESCRIPTION : This module kills PFTs based on light competition
62	!!
63	!! Here, fpc ("foilage projected cover") takes into account the minimum fraction
64	!! of space covered by trees through branches etc. This is done to prevent strong relative
65	!! changes of FPC from one day to another for deciduous trees at the beginning of their
66	!! growing season, which would yield too strong cutbacks.\n
67	!!
68	!! fpc is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is
69	!! to represent community ecology effects; seasonal variations in establishment related to phenology
70	!! may be relevant, but beyond the scope of a 1st generation DGVM.\n
71	!!
72	!! If agriculture is present, fpc can never reach 1.0 since natural veget_max < 1.0. To
73	!! correct for this, ::ind must be recalculated to correspond to the natural density.
74	!! since ::ind is expressed in m^{-2} grid cell, this can be achieved by dividing individual
75	!! density by the agricultural fraction.\n
76	!!
77	!! The flow in the routine is different for ::ok_dgvm. When ::ok_dgvm is true
78	!! the following processes are considered:
79	!!
80	!! No competition between woody pfts (height of individuals is not considered).
81	!! Exception: when one woody pft is overwhelming (i.e. fpc > fpc_crit). In that
82	!! case, eliminate all other woody pfts and reduce dominant pft to fpc_crit.
83	!! Age of individuals is not considered. In reality, light competition would more
84	!! easily kill young individuals, thus increasing the mean age of the stand.
85	!! Exclude agricultural pfts from competition.\n
86	!!
87	!! When ::ok_dgvm is false then light competition is calculated for the static case if the mortality is not
88	!! assumed to be constant. The following processes are considered: XXX
89	!!
90	!! RECENT CHANGE(S): None
91	!!
92	!! MAIN OUTPUT VARIABLE(S): ind, biomass, veget_lastlight, bm_to_litter, mortality
93	!!
94	!! REFERENCES :
95	!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
96	!! plant geography and terrestrial carbon cycling in the LPJ dynamic
97	!! global vegetation model, Global Change Biology, 9, 161-185.\n
98	!!
99	!! FLOWCHART : None
100	!! \n
101	!_ ================================================================================================================================
102
103	SUBROUTINE light (npts, dt, &
104	veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
105	lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality, &
106	!gmjc
107	sla_calc)
108	!end gmjc
109
110
111	!! 0. Variable and parameter declaration
112
113	!! 0.1 Input variables
114
115	INTEGER(i_std), INTENT(in) :: npts !! Domain size (unitless)
116	REAL(r_std), INTENT(in) :: dt !! Time step (days)
117	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent !! TRUE if pft is present (true/false)
118	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind !! Crown area of individuals
119	!! @tex $(m^2)$ @endtex
120	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai !! Leaf area index OF AN INDIVIDUAL PLANT
121	!! @tex $(m^2 m^{-2})$ @endtex
122	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear !! Last year's maximum fpc for each natural
123	!! PFT(unitless)
124	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lm_lastyearmax !! Last year's maximum leafmass for each
125	!! natural PFT
126	!! @tex $(gC m^2 s^{-1})$ @endtex
127	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max !! Last year's maximum fpc for each natural
128	!! PFT (unitless;0-1)
129	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fpc_max !! Last year's maximum fpc for each natural
130	!! PFT (unitless)
131	!gmjc
132	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: sla_calc
133	!end gmjc
134
135	!! 0.2 Output variables
136
137	!! 0.3 Modified variables
138
139	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals
140	!! @tex $(m^{-2})$ @endtex
141	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass !! Biomass @tex $(gCm^{-2})$ @endtex
142	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_lastlight !! Vegetation cover after last light
143	!! competition (unitless;0-1)
144	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! Biomass transfer to litter per timestep
145	!! @tex $(gCm^{-2})$ @endtex
146	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: mortality !! Fraction of individuals that died this
147	!! time step per dt (unitless;0-1)
148
149	!! 0.4 Local variables
150
151	LOGICAL, PARAMETER :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare
152	!! today's fpc to last year's Maximum (T)
153	!! or to fpc of last time step (F)
154	INTEGER(i_std) :: i,j,k,m !! Index (unitless)
155	REAL(r_std), DIMENSION(npts) :: sumfpc !! Total natural fpc, sum of all the PFTs
156	!! (unitless)
157	REAL(r_std), DIMENSION(npts) :: fracnat !! Fraction of natural vegetation within a
158	!! grid cell (unitless;0-1)
159	REAL(r_std) :: sumfpc_wood !! Total natural woody fpc (unitless)
160	REAL(r_std) :: sumdelta_fpc_wood !! Change in total woody fpc (unitless)
161	REAL(r_std) :: maxfpc_wood !! Maximum wood fpc (unitless)
162	INTEGER(i_std) :: optpft_wood !! Which woody pft is maximum (unitless)
163	REAL(r_std) :: sumfpc_grass !! Total natural grass fpc (unitless)
164	REAL(r_std), DIMENSION(npts,nvm) :: fpc_nat !! This year's foliage projected cover on
165	!! natural part of the grid cell
166	!! @tex $(m^2)$ @endtex
167	REAL(r_std), DIMENSION(nvm) :: deltafpc !! fpc change within last year (unitless)
168	REAL(r_std) :: reduct !! Relative change of number of individuals
169	!! for trees (ind)
170	REAL(r_std), DIMENSION(nvm) :: survive !! Fraction of plants that survive
171	!! (unitless;0-1)
172	REAL(r_std), DIMENSION(npts) :: fpc_real !! FPC for static mode (unitless)
173	REAL(r_std), DIMENSION(npts) :: lai_ind !! FPC mortality for static mode
174	REAL(r_std) :: sumfpc_grass2 !! New total grass fpc
175	REAL(r_std), DIMENSION(npts,nvm) :: light_death !! Fraction of plants that dies each day
176	!! @tex $(day^{-1})$ @endtex
177	REAL(r_std) :: fpc_dec !! Relative change of number of individuals
178	!! for trees
179	!_ ================================================================================================================================
180
181	IF (printlev>=3) WRITE(numout,*) 'Entering light'
182
183
184	!! 1. Write diagnostics to out_orchidee files
185
186	IF ( firstcall_light ) THEN
187
188	WRITE(numout,*) 'light:'
189
190	WRITE(numout,*) ' > For trees, minimum fraction of crown area covered'
191	WRITE(numout,*) ' (due to its branches etc.)', min_cover
192
193	WRITE(numout,*) ' > for diagnosis of fpc increase, compare today''s fpc'
194	IF ( annual_increase ) THEN
195	WRITE(numout,*) ' to last year''s maximum.'
196	ELSE
197	WRITE(numout,*) ' to fpc of the last time step.'
198	ENDIF
199
200	firstcall_light = .FALSE.
201
202	ENDIF
203
204	!! 2. Light competition in DGVM
205
206	IF (ok_dgvm) THEN
207
208	!! 2.1 Calculate natural part of the grid cell
209	fracnat(:) = un
210	DO j = 2,nvm
211	IF ( .NOT. natural(j) ) THEN
212	fracnat(:) = fracnat(:) - veget_max(:,j)
213	ENDIF
214	ENDDO
215
216	!! 2.2 Calculate fpc on natural part of grid cell
217	fpc_nat(:,:) = zero
218	fpc_nat(:,ibare_sechiba) = un
219
220	DO j = 2, nvm ! loop over #PFTs
221
222
223	!! 2.2.1 Natural PFTs
224	IF ( natural(j) ) THEN
225
226	!!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure?
227	!!?? CODE SHOULD BE CLEANED UP BELOW
228
229	!! 2.2.1.1 Trees
230	IF ( is_tree(j) ) THEN
231
232	! !! 2.1.1.1 trees: minimum cover due to stems, branches etc.
233	! DO i = 1, npts
234	! IF (lai(i,j) == val_exp) THEN
235	! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
236	! ELSE
237	! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
238	! MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
239	! ENDIF
240	! ENDDO
241	!NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
242
243	WHERE(fracnat(:).GE.min_stomate)
244
245	! WHERE(LAI(:,j) == val_exp)
246	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
247	! ELSEWHERE
248	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
249	! MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover )
250	! ENDWHERE
251
252	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
253	ENDWHERE
254
255	ELSE
256
257	!NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
258	!!?? DO GRASSES HAVE CROWNS?
259
260	!! 2.2.1.1 Grasses
261	WHERE(fracnat(:).GE.min_stomate)
262
263	! WHERE(LAI(:,j) == val_exp)
264	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
265	! ELSEWHERE
266	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
267	! ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
268	! ENDWHERE
269
270	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
271	ENDWHERE
272
273	!!!$ ! 2.1.1.2 bare ground
274	!!!$ IF (j == ibare_sechiba) THEN
275	!!!$ fpc_nat(:,j) = cn_ind(:,j) * ind(:,j)
276	!!!$
277	!!!$ ! 2.1.1.3 grasses
278	!!!$ ELSE
279	!!!$ DO i = 1, npts
280	!!!$ IF (lai(i,j) == val_exp) THEN
281	!!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
282	!!!$ ELSE
283	!!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
284	!!!$ ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) )
285	!!!$ ENDIF
286	!!!$ ENDDO
287	!!!$ ENDIF
288
289	ENDIF ! tree/grass
290
291	ELSE
292
293	!! 2.2.2 Agricultural PFTs
294	! Agriculural PFTs are not present on natural part
295	fpc_nat(:,j) = zero
296
297	ENDIF ! natural/agricultural
298
299	ENDDO
300
301
302	!! 2.3 Total fpc for grid point
303	sumfpc(:) = zero
304	DO j = 2,nvm
305
306	!S. Zaehle bug correction MERGE: need to subtract agricultural area!
307	sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
308	ENDDO
309
310
311	!! 2.4 Light competition
312
313	light_death(:,:) = zero
314
315	DO i = 1, npts ! S. Zaehle why this loop and not a vector statement ?
316
317	!! 2.4.1 Dense canopy
318	IF ( sumfpc(i) .GT. fpc_crit ) THEN
319
320	! 2.4.1.1 fpc change for each pft
321	! There are two possibilities: either we compare today's fpc with the fpc after the last
322	! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
323	! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
324	! As for trees, the cutback is proportional to this increase, this means that seasonal trees
325	! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its
326	! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
327
328	IF ( annual_increase ) THEN
329	deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero )
330	ELSE
331	deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero )
332	ENDIF
333
334	!! 2.4.1.2 Default survival
335	survive(:) = un
336
337
338	!! 2.4.1.3 Determine some characteristics of the fpc distribution
339	sumfpc_wood = zero
340	sumdelta_fpc_wood = zero
341	maxfpc_wood = zero
342	optpft_wood = 0
343	sumfpc_grass = zero
344
345	DO j = 2,nvm ! loop over #PFTs
346
347	!! 2.4.1.3.1 Natural pfts
348	IF ( natural(j) ) THEN
349
350	!! 2.4.1.3.1.1 Trees
351	IF ( is_tree(j) ) THEN
352
353	! total woody fpc
354	sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
355
356	! how much did the woody fpc increase
357	sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
358
359	! which woody pft is preponderant
360	IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
361
362	optpft_wood = j
363
364	maxfpc_wood = fpc_nat(i,j)
365
366	ENDIF
367
368	ELSE
369
370	!! 2.4.1.3.1.2 Grasses
371	! total (natural) grass fpc
372	sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
373
374	ENDIF ! tree or grass
375
376	ENDIF ! natural
377
378	ENDDO ! loop over pfts
379
380	!! 2.4.1.4 Wood outcompetes grass
381	! Light competition where wood outcompetes grasses
382
383	!S. Zaehle IF (sumfpc_wood .GE. fpc_crit ) THEN
384	!
385	!! 3.2.1 all allowed natural space is covered by wood:
386	!! cut back trees to fpc_crit.
387	!! Original DGVM: kill grasses. Modified: we let a very
388	!! small fraction of grasses survive.
389	!
390
391	DO j = 2,nvm ! Loop over #PFTs
392
393	! only present and natural pfts compete
394	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
395
396	!! 2.4.1.4.1 Trees
397	IF ( is_tree(j) ) THEN
398
399	! no single woody pft is overwhelming
400	! (original DGVM: tree_mercy = 0.0 )
401	! The reduction rate is proportional to the ratio deltafpc/fpc.
402	IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. &
403	sumdelta_fpc_wood .GT. min_stomate) THEN
404
405	! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
406	! (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
407	! ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
408
409	!!? difficult to fully understand but doesn't look so simple
410	reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) &
411	* deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
412
413	ELSE
414
415	! tree fpc didn't icrease or it started from nothing
416	reduct = zero
417
418	ENDIF
419	ELSE
420
421	!! 2.4.1.4.2 Grasses
422	! Let a very small fraction survive (the sum of all
423	! grass individuals may make up a maximum cover of
424	! grass_mercy [for lai -> infinity]).
425	! In the original DGVM, grasses were killed in that case,
426	! corresponding to grass_mercy = 0.
427	!
428
429	IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. &
430	sumfpc_grass.GE.min_stomate) THEN
431
432	fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
433
434	reduct = fpc_dec
435	ELSE
436	reduct = zero
437	ENDIF
438	ENDIF ! tree or grass
439
440	survive(j) = un - reduct
441	ENDIF ! pft there and natural
442
443	ENDDO ! loop over pfts
444
445	!S. Zaehle
446	!!!$ ELSE
447	!!!$
448	!!!$ !
449	!!!$ ! 3.2.2 not too much wood so that grasses can subsist
450	!!!$ !
451	!!!$
452	!!!$ ! new total grass fpc
453	!!!$ sumfpc_grass2 = fpc_crit - sumfpc_wood
454	!!!$
455	!!!$ DO j = 2,nvm
456	!!!$
457	!!!$ ! only present and natural PFTs compete
458	!!!$
459	!!!$ IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
460	!!!$
461	!!!$ IF ( is_tree(j) ) THEN
462	!!!$
463	!!!$ ! no change for trees
464	!!!$
465	!!!$ survive(j) = 1.0
466	!!!$
467	!!!$ ELSE
468	!!!$
469	!!!$ ! grass: fractional loss is the same for all grasses
470	!!!$
471	!!!$ IF ( sumfpc_grass .GT. min_stomate ) THEN
472	!!!$ survive(j) = sumfpc_grass2 / sumfpc_grass
473	!!!$ ELSE
474	!!!$ survive(j)= zero
475	!!!$ ENDIF
476	!!!$
477	!!!$ ENDIF
478	!!!$
479	!!!$ ENDIF ! pft there and natural
480	!!!$
481	!!!$ ENDDO ! loop over pfts
482	!!!$
483	!!!$ ENDIF ! sumfpc_wood > fpc_crit
484
485
486	!! 2.4.1.5 Update biomass and litter pools
487
488	DO j = 2,nvm ! Loop over #PFTs
489
490	! Natural PFTs
491	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
492
493	bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) + &
494	biomass(i,j,:,:) * ( un - survive(j) )
495
496	biomass(i,j,:,:) = biomass(i,j,:,:) * survive(j)
497
498	!? We are in a section where ok_dgvm is already at TRUE: No need to test it again
499	IF ( ok_dgvm ) THEN
500	ind(i,j) = ind(i,j) * survive(j)
501	ENDIF
502
503	! fraction of plants that dies each day.
504	! exact formulation: light_death(i,j) = un - survive(j) / dt
505	light_death(i,j) = ( un - survive(j) ) / dt
506
507	ENDIF ! pft there and natural
508
509	ENDDO ! loop over pfts
510
511	ENDIF ! sumfpc > fpc_crit
512
513	ENDDO ! loop over grid points
514
515
516	!! 2.5 Recalculate fpc for natural PFTs
517	! Recalculate fpc on natural part of the grid cell for next light competition
518	DO j = 2,nvm ! loop over #PFT
519
520	!! 2.5.1 Natural PFTs
521	IF ( natural(j) ) THEN
522
523	!! 2.5.1.1 Trees
524	IF ( is_tree(j) ) THEN
525
526	DO i = 1, npts
527
528	!NVMODIF
529	! IF (lai(i,j) == val_exp) THEN
530	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
531	! ELSE
532	! veget_lastlight(i,j) = &
533	! cn_ind(i,j) * ind(i,j) * &
534	! MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
535	! ENDIF
536	!! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
537
538	IF (lai(i,j) == val_exp) THEN
539	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
540	ELSE
541	veget_lastlight(i,j) = &
542	cn_ind(i,j) * ind(i,j) * &
543	MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla_calc(i,j) * ext_coeff(j) ) ), min_cover )
544	ENDIF
545	ENDDO
546
547	ELSE
548
549	!! 2.5.1.2 Grasses
550	DO i = 1, npts
551
552	!NVMODIF
553	! IF (lai(i,j) == val_exp) THEN
554	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
555	! ELSE
556	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
557	! ( un - exp( -lai(i,j) * ext_coeff(j) ) )
558	! ENDIF
559	!!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
560
561	IF (lai(i,j) == val_exp) THEN
562	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
563	ELSE
564	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
565	( un - exp( - lm_lastyearmax(i,j) * sla_calc(i,j) * ext_coeff(j) ) )
566	ENDIF
567	ENDDO
568	ENDIF ! tree/grass
569
570	ELSE
571
572	!! 2.5.2 Agricultural PFTs
573	! Agricultural PFTs are not present on the natural part of the grid point
574	veget_lastlight(:,j) = zero
575
576	ENDIF ! natural/agricultural
577
578	ENDDO ! # PFTs
579
580	ELSE ! ok_dgvm
581
582	!! 3. Light competition in stomate (without DGVM)
583
584	light_death(:,:) = zero
585
586	DO j = 2, nvm
587
588	IF ( natural(j) ) THEN
589
590	!! NUMBERING BELOW SHOULD BE 5.0 or 4.3
591	!! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
592	!! neither a redistribution of mortality (delta fpc)
593
594	!! 3.1 XXX
595	WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate )
596	lai_ind(:) = sla_calc(:,j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) )
597	ELSEWHERE
598	lai_ind(:) = zero
599	ENDWHERE
600
601	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) * &
602	MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
603
604	WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
605
606	light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j))
607
608	ENDWHERE
609
610	!! 3.2 Update biomass and litter pools
611	DO m = 1,nelements
612	DO k=1,nparts
613
614	bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m)
615	biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m)
616
617	ENDDO
618	END DO
619
620	!! 3.3 Update number of individuals
621	ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
622
623	ENDIF
624	ENDDO
625
626	light_death(:,:) = light_death(:,:)/dt
627
628	ENDIF ! ok_dgvm
629
630
631	!! 4. Write history files
632	CALL xios_orchidee_send_field("LIGHT_DEATH",light_death)
633
634	CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
635	light_death, npts*nvm, horipft_index)
636
637	IF (printlev>=4) WRITE(numout,*) 'Leaving light'
638
639	END SUBROUTINE light
640
641	END MODULE lpj_light

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

Download in other formats: