Context Navigation

lpj_light.f90 @ 7475

Last change on this file since 7475 was 1831, checked in by matthew.mcgrath, 11 years ago
DEV: Trunk merges up to and including r1789
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 27.5 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 = .TRUE. !! first call
40	!$OMP THREADPRIVATE(firstcall)
41
42	CONTAINS
43
44	!! ================================================================================================================================
45	!! SUBROUTINE : light_clear
46	!!
47	!>\BRIEF Activation
48	!!
49	!_ ================================================================================================================================
50
51	SUBROUTINE light_clear
52	firstcall=.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 ::control%ok_dgvm. When ::control%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 ::control%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
107
108	!! 0. Variable and parameter declaration
109
110	!! 0.1 Input variables
111
112	INTEGER(i_std), INTENT(in) :: npts !! Domain size (unitless)
113	REAL(r_std), INTENT(in) :: dt !! Time step (days)
114	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent !! TRUE if pft is present (true/false)
115	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind !! Crown area of individuals
116	!! @tex $(m^2)$ @endtex
117	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai !! Leaf area index OF AN INDIVIDUAL PLANT
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	INTEGER(i_std) :: i,j,k,m !! Index (unitless)
149	REAL(r_std), DIMENSION(npts) :: sumfpc !! Total natural fpc, sum of all the PFTs
150	!! (unitless)
151	REAL(r_std), DIMENSION(npts) :: fracnat !! Fraction of natural vegetation within a
152	!! grid cell (unitless;0-1)
153	REAL(r_std) :: sumfpc_wood !! Total natural woody fpc (unitless)
154	REAL(r_std) :: sumdelta_fpc_wood !! Change in total woody fpc (unitless)
155	REAL(r_std) :: maxfpc_wood !! Maximum wood fpc (unitless)
156	INTEGER(i_std) :: optpft_wood !! Which woody pft is maximum (unitless)
157	REAL(r_std) :: sumfpc_grass !! Total natural grass fpc (unitless)
158	REAL(r_std), DIMENSION(npts,nvm) :: fpc_nat !! This year's foliage projected cover on
159	!! natural part of the grid cell
160	!! @tex $(m^2)$ @endtex
161	REAL(r_std), DIMENSION(nvm) :: deltafpc !! fpc change within last year (unitless)
162	REAL(r_std) :: reduct !! Relative change of number of individuals
163	!! for trees (ind)
164	REAL(r_std), DIMENSION(nvm) :: survive !! Fraction of plants that survive
165	!! (unitless;0-1)
166	REAL(r_std), DIMENSION(npts) :: fpc_real !! FPC for static mode (unitless)
167	REAL(r_std), DIMENSION(npts) :: lai_ind !! FPC mortality for static mode
168	REAL(r_std) :: sumfpc_grass2 !! New total grass fpc
169	REAL(r_std), DIMENSION(npts,nvm) :: light_death !! Fraction of plants that dies each day
170	!! @tex $(day^{-1})$ @endtex
171	REAL(r_std) :: fpc_dec !! Relative change of number of individuals
172	!! for trees
173	!_ ================================================================================================================================
174
175	IF (bavard.GE.3) WRITE(numout,*) 'Entering light'
176
177
178	!! 1. Write diagnostics to out_orchidee files
179
180	IF ( firstcall ) THEN
181
182	WRITE(numout,*) 'light:'
183
184	WRITE(numout,*) ' > For trees, minimum fraction of crown area covered'
185	WRITE(numout,*) ' (due to its branches etc.)', min_cover
186
187	WRITE(numout,*) ' > for diagnosis of fpc increase, compare today''s fpc'
188	IF ( annual_increase ) THEN
189	WRITE(numout,*) ' to last year''s maximum.'
190	ELSE
191	WRITE(numout,*) ' to fpc of the last time step.'
192	ENDIF
193
194	firstcall = .FALSE.
195
196	ENDIF
197
198	!! 2. Light competition in DGVM
199
200	IF (control%ok_dgvm) THEN
201
202	!! 2.1 Calculate natural part of the grid cell
203	fracnat(:) = un
204	DO j = 2,nvm
205	IF ( .NOT. natural(j) ) THEN
206	fracnat(:) = fracnat(:) - veget_max(:,j)
207	ENDIF
208	ENDDO
209
210	!! 2.2 Calculate fpc on natural part of grid cell
211	fpc_nat(:,:) = zero
212	fpc_nat(:,ibare_sechiba) = un
213
214	DO j = 2, nvm ! loop over #PFTs
215
216
217	!! 2.2.1 Natural PFTs
218	IF ( natural(j) ) THEN
219
220	!!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure?
221	!!?? CODE SHOULD BE CLEANED UP BELOW
222
223	!! 2.2.1.1 Trees
224	IF ( is_tree(j) ) THEN
225
226	! !! 2.1.1.1 trees: minimum cover due to stems, branches etc.
227	! DO i = 1, npts
228	! IF (lai(i,j) == val_exp) THEN
229	! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
230	! ELSE
231	! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
232	! MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
233	! ENDIF
234	! ENDDO
235	!NV : modif from SZ version : fpc is based on veget_max, not veget.
236
237	WHERE(fracnat(:).GE.min_stomate)
238
239	! WHERE(LAI(:,j) == val_exp)
240	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
241	! ELSEWHERE
242	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
243	! MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover )
244	! ENDWHERE
245
246	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
247	ENDWHERE
248
249	ELSE
250
251	!NV : modif from SZ version : fpc is based on veget_max, not veget.
252	!!?? DO GRASSES HAVE CROWNS?
253
254	!! 2.2.1.1 Grasses
255	WHERE(fracnat(:).GE.min_stomate)
256
257	! WHERE(LAI(:,j) == val_exp)
258	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
259	! ELSEWHERE
260	! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
261	! ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
262	! ENDWHERE
263
264	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
265	ENDWHERE
266
267	!!!$ ! 2.1.1.2 bare ground
268	!!!$ IF (j == ibare_sechiba) THEN
269	!!!$ fpc_nat(:,j) = cn_ind(:,j) * ind(:,j)
270	!!!$
271	!!!$ ! 2.1.1.3 grasses
272	!!!$ ELSE
273	!!!$ DO i = 1, npts
274	!!!$ IF (lai(i,j) == val_exp) THEN
275	!!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
276	!!!$ ELSE
277	!!!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
278	!!!$ ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) )
279	!!!$ ENDIF
280	!!!$ ENDDO
281	!!!$ ENDIF
282
283	ENDIF ! tree/grass
284
285	ELSE
286
287	!! 2.2.2 Agricultural PFTs
288	! Agriculural PFTs are not present on natural part
289	fpc_nat(:,j) = zero
290
291	ENDIF ! natural/agricultural
292
293	ENDDO
294
295
296	!! 2.3 Total fpc for grid point
297	sumfpc(:) = zero
298	DO j = 2,nvm
299
300	!SZ bug correction MERGE: need to subtract agricultural area!
301	sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
302	ENDDO
303
304
305	!! 2.4 Light competition
306
307	light_death(:,:) = zero
308
309	DO i = 1, npts ! SZ why this loop and not a vector statement ?
310
311	!! 2.4.1 Dense canopy
312	IF ( sumfpc(i) .GT. fpc_crit ) THEN
313
314	! 2.4.1.1 fpc change for each pft
315	! There are two possibilities: either we compare today's fpc with the fpc after the last
316	! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
317	! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
318	! As for trees, the cutback is proportional to this increase, this means that seasonal trees
319	! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its
320	! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
321
322	IF ( annual_increase ) THEN
323	deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero )
324	ELSE
325	deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero )
326	ENDIF
327
328	!! 2.4.1.2 Default survival
329	survive(:) = un
330
331
332	!! 2.4.1.3 Determine some characteristics of the fpc distribution
333	sumfpc_wood = zero
334	sumdelta_fpc_wood = zero
335	maxfpc_wood = zero
336	optpft_wood = 0
337	sumfpc_grass = zero
338
339	DO j = 2,nvm ! loop over #PFTs
340
341	IF(veget_max(i,j) == zero)THEN
342	! this vegetation type is not present, so no reason to do the
343	! calculation
344	CYCLE
345	ENDIF
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	!SZ 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
394	IF(veget_max(i,j) == zero)THEN
395	! this vegetation type is not present, so no reason to do the
396	! calculation
397	CYCLE
398	ENDIF
399
400
401	! only present and natural pfts compete
402	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
403
404	!! 2.4.1.4.1 Trees
405	IF ( is_tree(j) ) THEN
406
407	! no single woody pft is overwhelming
408	! (original DGVM: tree_mercy = 0.0 )
409	! The reduction rate is proportional to the ratio deltafpc/fpc.
410	IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. &
411	sumdelta_fpc_wood .GT. min_stomate) THEN
412
413	! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
414	! (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
415	! ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
416
417	!!? difficult to fully understand but doesn't look so simple
418	reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) &
419	* deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
420
421	ELSE
422
423	! tree fpc didn't icrease or it started from nothing
424	reduct = zero
425
426	ENDIF
427	ELSE
428
429	!! 2.4.1.4.2 Grasses
430	! Let a very small fraction survive (the sum of all
431	! grass individuals may make up a maximum cover of
432	! grass_mercy [for lai -> infinity]).
433	! In the original DGVM, grasses were killed in that case,
434	! corresponding to grass_mercy = 0.
435	!
436
437	IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. &
438	sumfpc_grass.GE.min_stomate) THEN
439
440	fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
441
442	reduct = fpc_dec
443	ELSE
444	reduct = zero
445	ENDIF
446	ENDIF ! tree or grass
447
448	survive(j) = un - reduct
449	ENDIF ! pft there and natural
450
451	ENDDO ! loop over pfts
452
453	!SZ
454	!!!$ ELSE
455	!!!$
456	!!!$ !
457	!!!$ ! 3.2.2 not too much wood so that grasses can subsist
458	!!!$ !
459	!!!$
460	!!!$ ! new total grass fpc
461	!!!$ sumfpc_grass2 = fpc_crit - sumfpc_wood
462	!!!$
463	!!!$ DO j = 2,nvm
464	!!!$
465	!!!$ ! only present and natural PFTs compete
466	!!!$
467	!!!$ IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
468	!!!$
469	!!!$ IF ( is_tree(j) ) THEN
470	!!!$
471	!!!$ ! no change for trees
472	!!!$
473	!!!$ survive(j) = 1.0
474	!!!$
475	!!!$ ELSE
476	!!!$
477	!!!$ ! grass: fractional loss is the same for all grasses
478	!!!$
479	!!!$ IF ( sumfpc_grass .GT. min_stomate ) THEN
480	!!!$ survive(j) = sumfpc_grass2 / sumfpc_grass
481	!!!$ ELSE
482	!!!$ survive(j)= zero
483	!!!$ ENDIF
484	!!!$
485	!!!$ ENDIF
486	!!!$
487	!!!$ ENDIF ! pft there and natural
488	!!!$
489	!!!$ ENDDO ! loop over pfts
490	!!!$
491	!!!$ ENDIF ! sumfpc_wood > fpc_crit
492
493
494	!! 2.4.1.5 Update biomass and litter pools
495
496	DO j = 2,nvm ! Loop over #PFTs
497
498
499	IF(veget_max(i,j) == zero)THEN
500	! this vegetation type is not present, so no reason to do the
501	! calculation
502	CYCLE
503	ENDIF
504
505
506	! Natural PFTs
507	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
508
509	bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) + &
510	biomass(i,j,:,:) * ( un - survive(j) )
511
512	biomass(i,j,:,:) = biomass(i,j,:,:) * survive(j)
513
514	!? We are in a section where ok_dgvm is already at TRUE: No need to test it again
515	IF ( control%ok_dgvm ) THEN
516	ind(i,j) = ind(i,j) * survive(j)
517	ENDIF
518
519	! fraction of plants that dies each day.
520	! exact formulation: light_death(i,j) = un - survive(j) / dt
521	light_death(i,j) = ( un - survive(j) ) / dt
522
523	ENDIF ! pft there and natural
524
525	ENDDO ! loop over pfts
526
527	ENDIF ! sumfpc > fpc_crit
528
529	ENDDO ! loop over grid points
530
531
532	!! 2.5 Recalculate fpc for natural PFTs
533	! Recalculate fpc on natural part of the grid cell for next light competition
534	DO j = 2,nvm ! loop over #PFT
535
536
537	IF(veget_max(i,j) == zero)THEN
538	! this vegetation type is not present, so no reason to do the
539	! calculation
540	CYCLE
541	ENDIF
542
543
544	!! 2.5.1 Natural PFTs
545	IF ( natural(j) ) THEN
546
547	!! 2.5.1.1 Trees
548	IF ( is_tree(j) ) THEN
549
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) = &
557	! cn_ind(i,j) * ind(i,j) * &
558	! MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
559	! ENDIF
560	!! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
561
562	IF (lai(i,j) == val_exp) THEN
563	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
564	ELSE
565	veget_lastlight(i,j) = &
566	cn_ind(i,j) * ind(i,j) * &
567	MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover )
568	ENDIF
569	ENDDO
570
571	ELSE
572
573	!! 2.5.1.2 Grasses
574	DO i = 1, npts
575
576	!NVMODIF
577	! IF (lai(i,j) == val_exp) THEN
578	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
579	! ELSE
580	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
581	! ( un - exp( -lai(i,j) * ext_coeff(j) ) )
582	! ENDIF
583	!!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
584
585	IF (lai(i,j) == val_exp) THEN
586	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
587	ELSE
588	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
589	( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) )
590	ENDIF
591	ENDDO
592	ENDIF ! tree/grass
593
594	ELSE
595
596	!! 2.5.2 Agricultural PFTs
597	! Agricultural PFTs are not present on the natural part of the grid point
598	veget_lastlight(:,j) = zero
599
600	ENDIF ! natural/agricultural
601
602	ENDDO ! # PFTs
603
604	ELSE ! control%ok_dgvm
605
606	!! 3. Light competition in stomate (without DGVM)
607
608	light_death(:,:) = zero
609
610	DO j = 2, nvm
611
612	IF(veget_max(i,j) == zero)THEN
613	! this vegetation type is not present, so no reason to do the
614	! calculation
615	CYCLE
616	ENDIF
617
618
619	IF ( natural(j) ) THEN
620
621	!! NUMBERING BELOW SHOULD BE 5.0 or 4.3
622	!! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
623	!! neither a redistribution of mortality (delta fpc)
624
625	!! 3.1 XXX
626	WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate )
627	lai_ind(:) = sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) )
628	ELSEWHERE
629	lai_ind(:) = zero
630	ENDWHERE
631
632	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) * &
633	MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
634
635	WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
636
637	light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j))
638
639	ENDWHERE
640
641	!! 3.2 Update biomass and litter pools
642	DO m = 1,nelements
643	DO k=1,nparts
644
645	bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m)
646	biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m)
647
648	ENDDO
649	END DO
650
651	!! 3.3 Update number of individuals
652	ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
653
654	ENDIF
655	ENDDO
656
657	light_death(:,:) = light_death(:,:)/dt
658
659	ENDIF ! control%ok_dgvm
660
661
662	!! 4. Write history files
663	CALL xios_orchidee_send_field("LIGHT_DEATH",light_death)
664
665	CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
666	light_death, npts*nvm, horipft_index)
667
668	IF (bavard.GE.4) WRITE(numout,*) 'Leaving light'
669
670	END SUBROUTINE light
671
672	END MODULE lpj_light

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

Context Navigation

source: branches/publications/ORCHIDEE_CAN_r3069/src_stomate/lpj_light.f90 @ 7475

Download in other formats: