Context Navigation

source: branches/publications/ORCHIDEE_gmd-2018-261/src_stomate/lpj_light.f90 @ 7540

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

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

Download in other formats: