Context Navigation

source: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_light.f90 @ 6412

Last change on this file since 6412 was 4492, checked in by alex.resovsky, 7 years ago
Bugfixes in sechiba and stomate for ticket #281. LAI is now calculated from leaf biomass wherever needed unless read_LAI=y.
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 27.1 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, 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	!! @tex $(m^2 m^{-2})$ @endtex
119	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear !! Last year's maximum fpc for each natural
120	!! PFT(unitless)
121	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lm_lastyearmax !! Last year's maximum leafmass for each
122	!! natural PFT
123	!! @tex $(gC m^2 s^{-1})$ @endtex
124	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max !! Last year's maximum fpc for each natural
125	!! PFT (unitless;0-1)
126	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fpc_max !! Last year's maximum fpc for each natural
127	!! PFT (unitless)
128
129	!! 0.2 Output variables
130
131	!! 0.3 Modified variables
132
133	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals
134	!! @tex $(m^{-2})$ @endtex
135	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass !! Biomass @tex $(gCm^{-2})$ @endtex
136	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_lastlight !! Vegetation cover after last light
137	!! competition (unitless;0-1)
138	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! Biomass transfer to litter per timestep
139	!! @tex $(gCm^{-2})$ @endtex
140	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: mortality !! Fraction of individuals that died this
141	!! time step per dt (unitless;0-1)
142
143	!! 0.4 Local variables
144
145	LOGICAL, PARAMETER :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare
146	!! today's fpc to last year's Maximum (T)
147	!! or to fpc of last time step (F)
148	REAL(r_std), DIMENSION(npts,nvm) :: lai !! Leaf area index OF AN INDIVIDUAL PLANT
149	INTEGER(i_std) :: i,j,k,m !! Index (unitless)
150	INTEGER(i_std) :: ipts, ivm !! Indices (unitless)
151	REAL(r_std), DIMENSION(npts) :: sumfpc !! Total natural fpc, sum of all the PFTs
152	!! (unitless)
153	REAL(r_std), DIMENSION(npts) :: fracnat !! Fraction of natural vegetation within a
154	!! grid cell (unitless;0-1)
155	REAL(r_std) :: sumfpc_wood !! Total natural woody fpc (unitless)
156	REAL(r_std) :: sumdelta_fpc_wood !! Change in total woody fpc (unitless)
157	REAL(r_std) :: maxfpc_wood !! Maximum wood fpc (unitless)
158	INTEGER(i_std) :: optpft_wood !! Which woody pft is maximum (unitless)
159	REAL(r_std) :: sumfpc_grass !! Total natural grass fpc (unitless)
160	REAL(r_std), DIMENSION(npts,nvm) :: fpc_nat !! This year's foliage projected cover on
161	!! natural part of the grid cell
162	!! @tex $(m^2)$ @endtex
163	REAL(r_std), DIMENSION(nvm) :: deltafpc !! fpc change within last year (unitless)
164	REAL(r_std) :: reduct !! Relative change of number of individuals
165	!! for trees (ind)
166	REAL(r_std), DIMENSION(nvm) :: survive !! Fraction of plants that survive
167	!! (unitless;0-1)
168	REAL(r_std), DIMENSION(npts) :: fpc_real !! FPC for static mode (unitless)
169	REAL(r_std), DIMENSION(npts) :: lai_ind !! FPC mortality for static mode
170	REAL(r_std) :: sumfpc_grass2 !! New total grass fpc
171	REAL(r_std), DIMENSION(npts,nvm) :: light_death !! Fraction of plants that dies each day
172	!! @tex $(day^{-1})$ @endtex
173	REAL(r_std) :: fpc_dec !! Relative change of number of individuals
174	!! for trees
175	!_ ================================================================================================================================
176
177	IF (printlev>=3) WRITE(numout,*) 'Entering light'
178
179	!! 0. Calculate the LAI from the biomass.
180	! This is done to prevent passing an incorrect
181	! LAI around, since LAI is diagnostic.
182	! We can't do this if we use an LAI map! So this breaks DO_STOMATE=N
183	lai(:,ibare_sechiba) = zero
184	DO ipts = 1, npts
185	DO ivm = 1, nvm
186	lai(ipts,ivm) = biomass_to_lai(biomass(ipts,ivm,ileaf,icarbon),ivm)
187	ENDDO
188	ENDDO
189
190	!! 1. Write diagnostics to out_orchidee files
191
192	IF ( firstcall_light ) THEN
193
194	WRITE(numout,*) 'light:'
195
196	WRITE(numout,*) ' > For trees, minimum fraction of crown area covered'
197	WRITE(numout,*) ' (due to its branches etc.)', min_cover
198
199	WRITE(numout,*) ' > for diagnosis of fpc increase, compare today''s fpc'
200	IF ( annual_increase ) THEN
201	WRITE(numout,*) ' to last year''s maximum.'
202	ELSE
203	WRITE(numout,*) ' to fpc of the last time step.'
204	ENDIF
205
206	firstcall_light = .FALSE.
207
208	ENDIF
209
210	!! 2. Light competition in DGVM
211
212	IF (ok_dgvm) THEN
213
214	!! 2.1 Calculate natural part of the grid cell
215	fracnat(:) = un
216	DO j = 2,nvm
217	IF ( .NOT. natural(j) ) THEN
218	fracnat(:) = fracnat(:) - veget_max(:,j)
219	ENDIF
220	ENDDO
221
222	!! 2.2 Calculate fpc on natural part of grid cell
223	fpc_nat(:,:) = zero
224	fpc_nat(:,ibare_sechiba) = un
225
226	DO j = 2, nvm ! loop over #PFTs
227
228
229	!! 2.2.1 Natural PFTs
230	IF ( natural(j) ) THEN
231
232	!!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure?
233	!!?? CODE SHOULD BE CLEANED UP BELOW
234
235	!! 2.2.1.1 Trees
236	IF ( is_tree(j) ) THEN
237
238	! !! 2.1.1.1 trees: minimum cover due to stems, branches etc.
239	! DO i = 1, npts
240	! IF (lai(i,j) == val_exp) THEN
241	! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
242	! ELSE
243	! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
244	! MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
245	! ENDIF
246	! ENDDO
247	!NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
248
249	WHERE(fracnat(:).GE.min_stomate)
250
251	! WHERE(LAI(:,j) == val_exp)
252	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
253	! ELSEWHERE
254	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
255	! MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover )
256	! ENDWHERE
257
258	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
259	ENDWHERE
260
261	ELSE
262
263	!NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
264	!!?? DO GRASSES HAVE CROWNS?
265
266	!! 2.2.1.1 Grasses
267	WHERE(fracnat(:).GE.min_stomate)
268
269	! WHERE(LAI(:,j) == val_exp)
270	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
271	! ELSEWHERE
272	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
273	! ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
274	! ENDWHERE
275
276	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
277	ENDWHERE
278
279	!!!$ ! 2.1.1.2 bare ground
280	!!!$ IF (j == ibare_sechiba) THEN
281	!!!$ fpc_nat(:,j) = cn_ind(:,j) * ind(:,j)
282	!!!$
283	!!!$ ! 2.1.1.3 grasses
284	!!!$ ELSE
285	!!!$ DO i = 1, npts
286	!!!$ IF (lai(i,j) == val_exp) THEN
287	!!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
288	!!!$ ELSE
289	!!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
290	!!!$ ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) )
291	!!!$ ENDIF
292	!!!$ ENDDO
293	!!!$ ENDIF
294
295	ENDIF ! tree/grass
296
297	ELSE
298
299	!! 2.2.2 Agricultural PFTs
300	! Agriculural PFTs are not present on natural part
301	fpc_nat(:,j) = zero
302
303	ENDIF ! natural/agricultural
304
305	ENDDO
306
307
308	!! 2.3 Total fpc for grid point
309	sumfpc(:) = zero
310	DO j = 2,nvm
311
312	!S. Zaehle bug correction MERGE: need to subtract agricultural area!
313	sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
314	ENDDO
315
316
317	!! 2.4 Light competition
318
319	light_death(:,:) = zero
320
321	DO i = 1, npts ! S. Zaehle why this loop and not a vector statement ?
322
323	!! 2.4.1 Dense canopy
324	IF ( sumfpc(i) .GT. fpc_crit ) THEN
325
326	! 2.4.1.1 fpc change for each pft
327	! There are two possibilities: either we compare today's fpc with the fpc after the last
328	! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
329	! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
330	! As for trees, the cutback is proportional to this increase, this means that seasonal trees
331	! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its
332	! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
333
334	IF ( annual_increase ) THEN
335	deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero )
336	ELSE
337	deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero )
338	ENDIF
339
340	!! 2.4.1.2 Default survival
341	survive(:) = un
342
343
344	!! 2.4.1.3 Determine some characteristics of the fpc distribution
345	sumfpc_wood = zero
346	sumdelta_fpc_wood = zero
347	maxfpc_wood = zero
348	optpft_wood = 0
349	sumfpc_grass = zero
350
351	DO j = 2,nvm ! loop over #PFTs
352
353	!! 2.4.1.3.1 Natural pfts
354	IF ( natural(j) ) THEN
355
356	!! 2.4.1.3.1.1 Trees
357	IF ( is_tree(j) ) THEN
358
359	! total woody fpc
360	sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
361
362	! how much did the woody fpc increase
363	sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
364
365	! which woody pft is preponderant
366	IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
367
368	optpft_wood = j
369
370	maxfpc_wood = fpc_nat(i,j)
371
372	ENDIF
373
374	ELSE
375
376	!! 2.4.1.3.1.2 Grasses
377	! total (natural) grass fpc
378	sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
379
380	ENDIF ! tree or grass
381
382	ENDIF ! natural
383
384	ENDDO ! loop over pfts
385
386	!! 2.4.1.4 Wood outcompetes grass
387	! Light competition where wood outcompetes grasses
388
389	!S. Zaehle IF (sumfpc_wood .GE. fpc_crit ) THEN
390	!
391	!! 3.2.1 all allowed natural space is covered by wood:
392	!! cut back trees to fpc_crit.
393	!! Original DGVM: kill grasses. Modified: we let a very
394	!! small fraction of grasses survive.
395	!
396
397	DO j = 2,nvm ! Loop over #PFTs
398
399	! only present and natural pfts compete
400	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
401
402	!! 2.4.1.4.1 Trees
403	IF ( is_tree(j) ) THEN
404
405	! no single woody pft is overwhelming
406	! (original DGVM: tree_mercy = 0.0 )
407	! The reduction rate is proportional to the ratio deltafpc/fpc.
408	IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. &
409	sumdelta_fpc_wood .GT. min_stomate) THEN
410
411	! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
412	! (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
413	! ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
414
415	!!? difficult to fully understand but doesn't look so simple
416	reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) &
417	* deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
418
419	ELSE
420
421	! tree fpc didn't icrease or it started from nothing
422	reduct = zero
423
424	ENDIF
425	ELSE
426
427	!! 2.4.1.4.2 Grasses
428	! Let a very small fraction survive (the sum of all
429	! grass individuals may make up a maximum cover of
430	! grass_mercy [for lai -> infinity]).
431	! In the original DGVM, grasses were killed in that case,
432	! corresponding to grass_mercy = 0.
433	!
434
435	IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. &
436	sumfpc_grass.GE.min_stomate) THEN
437
438	fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
439
440	reduct = fpc_dec
441	ELSE
442	reduct = zero
443	ENDIF
444	ENDIF ! tree or grass
445
446	survive(j) = un - reduct
447	ENDIF ! pft there and natural
448
449	ENDDO ! loop over pfts
450
451	!S. Zaehle
452	!!!$ ELSE
453	!!!$
454	!!!$ !
455	!!!$ ! 3.2.2 not too much wood so that grasses can subsist
456	!!!$ !
457	!!!$
458	!!!$ ! new total grass fpc
459	!!!$ sumfpc_grass2 = fpc_crit - sumfpc_wood
460	!!!$
461	!!!$ DO j = 2,nvm
462	!!!$
463	!!!$ ! only present and natural PFTs compete
464	!!!$
465	!!!$ IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
466	!!!$
467	!!!$ IF ( is_tree(j) ) THEN
468	!!!$
469	!!!$ ! no change for trees
470	!!!$
471	!!!$ survive(j) = 1.0
472	!!!$
473	!!!$ ELSE
474	!!!$
475	!!!$ ! grass: fractional loss is the same for all grasses
476	!!!$
477	!!!$ IF ( sumfpc_grass .GT. min_stomate ) THEN
478	!!!$ survive(j) = sumfpc_grass2 / sumfpc_grass
479	!!!$ ELSE
480	!!!$ survive(j)= zero
481	!!!$ ENDIF
482	!!!$
483	!!!$ ENDIF
484	!!!$
485	!!!$ ENDIF ! pft there and natural
486	!!!$
487	!!!$ ENDDO ! loop over pfts
488	!!!$
489	!!!$ ENDIF ! sumfpc_wood > fpc_crit
490
491
492	!! 2.4.1.5 Update biomass and litter pools
493
494	DO j = 2,nvm ! Loop over #PFTs
495
496	! Natural PFTs
497	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
498
499	bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) + &
500	biomass(i,j,:,:) * ( un - survive(j) )
501
502	biomass(i,j,:,:) = biomass(i,j,:,:) * survive(j)
503
504	!? We are in a section where ok_dgvm is already at TRUE: No need to test it again
505	IF ( ok_dgvm ) THEN
506	ind(i,j) = ind(i,j) * survive(j)
507	ENDIF
508
509	! fraction of plants that dies each day.
510	! exact formulation: light_death(i,j) = un - survive(j) / dt
511	light_death(i,j) = ( un - survive(j) ) / dt
512
513	ENDIF ! pft there and natural
514
515	ENDDO ! loop over pfts
516
517	ENDIF ! sumfpc > fpc_crit
518
519	ENDDO ! loop over grid points
520
521
522	!! 2.5 Recalculate fpc for natural PFTs
523	! Recalculate fpc on natural part of the grid cell for next light competition
524	DO j = 2,nvm ! loop over #PFT
525
526	!! 2.5.1 Natural PFTs
527	IF ( natural(j) ) THEN
528
529	!! 2.5.1.1 Trees
530	IF ( is_tree(j) ) THEN
531
532	DO i = 1, npts
533
534	!NVMODIF
535	! IF (lai(i,j) == val_exp) THEN
536	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
537	! ELSE
538	! veget_lastlight(i,j) = &
539	! cn_ind(i,j) * ind(i,j) * &
540	! MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
541	! ENDIF
542	!! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
543
544	IF (lai(i,j) == val_exp) THEN
545	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
546	ELSE
547	veget_lastlight(i,j) = &
548	cn_ind(i,j) * ind(i,j) * &
549	MAX( ( un - EXP( - biomass_to_lai(lm_lastyearmax(i,j),j) * ext_coeff(j) ) ), min_cover )
550	ENDIF
551	ENDDO
552
553	ELSE
554
555	!! 2.5.1.2 Grasses
556	DO i = 1, npts
557
558	!NVMODIF
559	! IF (lai(i,j) == val_exp) THEN
560	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
561	! ELSE
562	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
563	! ( un - exp( -lai(i,j) * ext_coeff(j) ) )
564	! ENDIF
565	!!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
566	IF (lai(i,j) == val_exp) THEN
567	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
568	ELSE
569	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
570	( un - exp( - biomass_to_lai(lm_lastyearmax(i,j),j) * ext_coeff(j) ) )
571	ENDIF
572	ENDDO
573	ENDIF ! tree/grass
574
575	ELSE
576
577	!! 2.5.2 Agricultural PFTs
578	! Agricultural PFTs are not present on the natural part of the grid point
579	veget_lastlight(:,j) = zero
580
581	ENDIF ! natural/agricultural
582
583	ENDDO ! # PFTs
584
585	ELSE ! ok_dgvm
586
587	!! 3. Light competition in stomate (without DGVM)
588
589	light_death(:,:) = zero
590
591	DO j = 2, nvm
592
593	IF ( natural(j) ) THEN
594
595	!! NUMBERING BELOW SHOULD BE 5.0 or 4.3
596	!! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
597	!! neither a redistribution of mortality (delta fpc)
598	!! 3.1 XXX
599	WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate )
600	lai_ind(:) = biomass_to_lai(lm_lastyearmax(:,j),npts,j) / ( ind(:,j) * cn_ind(:,j) )
601	ELSEWHERE
602	lai_ind(:) = zero
603	ENDWHERE
604
605	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) * &
606	MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
607
608	WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
609
610	light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j))
611
612	ENDWHERE
613
614	!! 3.2 Update biomass and litter pools
615	DO m = 1,nelements
616	DO k=1,nparts
617
618	bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m)
619	biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m)
620
621	ENDDO
622	END DO
623
624	!! 3.3 Update number of individuals
625	ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
626
627	ENDIF
628	ENDDO
629
630	light_death(:,:) = light_death(:,:)/dt
631
632	ENDIF ! ok_dgvm
633
634
635	!! 4. Write history files
636	CALL xios_orchidee_send_field("LIGHT_DEATH",light_death)
637
638	CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
639	light_death, npts*nvm, horipft_index)
640
641	IF (printlev>=4) WRITE(numout,*) 'Leaving light'
642
643	END SUBROUTINE light
644
645	END MODULE lpj_light

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

Download in other formats: