Context Navigation

lpj_light.f90 @ 5925

Last change on this file since 5925 was 2738, checked in by josefine.ghattas, 9 years ago

Small modifications for TAF :

hydrolc_waterbal : removed argument first_call never used.
hydrolc_alma : extracted the initialization part into hydrolc_alma_init
stomate_season.f90 : cloud becomes a local temporary variable. Note that this variable is never calculated, it is only set =0.
forcing_read in module stomate is renamed into stomate_forcing_read
routing_waterbal : rename firstcall into reinit. Variables with name firstcall must be global with attribute SAVE.
Changed name on the variable firstcall into firstcall_xx to have unique name in each module. Done in following subroutines : stomate_vmax, stomate_turnover, stomate_soilcarbon, stomate_season, stomate_resp, stomate_prescribe, stomate_phenology, stomate_npp, stomate_litter, stomate_io, stomate_alloc, lpj_pftinout, lpj_light, lpj_gap, lpj_fire, lpj_establish, lpj_constraints, hydrolc, solar, weather
Removed firstcall never used : stomate_lpj

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
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
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 (printlev>=3) WRITE(numout,*) 'Entering light'
176
177
178	!! 1. Write diagnostics to out_orchidee files
179
180	IF ( firstcall_light ) 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_light = .FALSE.
195
196	ENDIF
197
198	!! 2. Light competition in DGVM
199
200	IF (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 S. Zaehle 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 S. Zaehle 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	!S. Zaehle 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 ! S. Zaehle 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	!! 2.4.1.3.1 Natural pfts
342	IF ( natural(j) ) THEN
343
344	!! 2.4.1.3.1.1 Trees
345	IF ( is_tree(j) ) THEN
346
347	! total woody fpc
348	sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
349
350	! how much did the woody fpc increase
351	sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
352
353	! which woody pft is preponderant
354	IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
355
356	optpft_wood = j
357
358	maxfpc_wood = fpc_nat(i,j)
359
360	ENDIF
361
362	ELSE
363
364	!! 2.4.1.3.1.2 Grasses
365	! total (natural) grass fpc
366	sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
367
368	ENDIF ! tree or grass
369
370	ENDIF ! natural
371
372	ENDDO ! loop over pfts
373
374	!! 2.4.1.4 Wood outcompetes grass
375	! Light competition where wood outcompetes grasses
376
377	!S. Zaehle IF (sumfpc_wood .GE. fpc_crit ) THEN
378	!
379	!! 3.2.1 all allowed natural space is covered by wood:
380	!! cut back trees to fpc_crit.
381	!! Original DGVM: kill grasses. Modified: we let a very
382	!! small fraction of grasses survive.
383	!
384
385	DO j = 2,nvm ! Loop over #PFTs
386
387	! only present and natural pfts compete
388	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
389
390	!! 2.4.1.4.1 Trees
391	IF ( is_tree(j) ) THEN
392
393	! no single woody pft is overwhelming
394	! (original DGVM: tree_mercy = 0.0 )
395	! The reduction rate is proportional to the ratio deltafpc/fpc.
396	IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. &
397	sumdelta_fpc_wood .GT. min_stomate) THEN
398
399	! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
400	! (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
401	! ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
402
403	!!? difficult to fully understand but doesn't look so simple
404	reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) &
405	* deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
406
407	ELSE
408
409	! tree fpc didn't icrease or it started from nothing
410	reduct = zero
411
412	ENDIF
413	ELSE
414
415	!! 2.4.1.4.2 Grasses
416	! Let a very small fraction survive (the sum of all
417	! grass individuals may make up a maximum cover of
418	! grass_mercy [for lai -> infinity]).
419	! In the original DGVM, grasses were killed in that case,
420	! corresponding to grass_mercy = 0.
421	!
422
423	IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. &
424	sumfpc_grass.GE.min_stomate) THEN
425
426	fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
427
428	reduct = fpc_dec
429	ELSE
430	reduct = zero
431	ENDIF
432	ENDIF ! tree or grass
433
434	survive(j) = un - reduct
435	ENDIF ! pft there and natural
436
437	ENDDO ! loop over pfts
438
439	!S. Zaehle
440	!!!$ ELSE
441	!!!$
442	!!!$ !
443	!!!$ ! 3.2.2 not too much wood so that grasses can subsist
444	!!!$ !
445	!!!$
446	!!!$ ! new total grass fpc
447	!!!$ sumfpc_grass2 = fpc_crit - sumfpc_wood
448	!!!$
449	!!!$ DO j = 2,nvm
450	!!!$
451	!!!$ ! only present and natural PFTs compete
452	!!!$
453	!!!$ IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
454	!!!$
455	!!!$ IF ( is_tree(j) ) THEN
456	!!!$
457	!!!$ ! no change for trees
458	!!!$
459	!!!$ survive(j) = 1.0
460	!!!$
461	!!!$ ELSE
462	!!!$
463	!!!$ ! grass: fractional loss is the same for all grasses
464	!!!$
465	!!!$ IF ( sumfpc_grass .GT. min_stomate ) THEN
466	!!!$ survive(j) = sumfpc_grass2 / sumfpc_grass
467	!!!$ ELSE
468	!!!$ survive(j)= zero
469	!!!$ ENDIF
470	!!!$
471	!!!$ ENDIF
472	!!!$
473	!!!$ ENDIF ! pft there and natural
474	!!!$
475	!!!$ ENDDO ! loop over pfts
476	!!!$
477	!!!$ ENDIF ! sumfpc_wood > fpc_crit
478
479
480	!! 2.4.1.5 Update biomass and litter pools
481
482	DO j = 2,nvm ! Loop over #PFTs
483
484	! Natural PFTs
485	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
486
487	bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) + &
488	biomass(i,j,:,:) * ( un - survive(j) )
489
490	biomass(i,j,:,:) = biomass(i,j,:,:) * survive(j)
491
492	!? We are in a section where ok_dgvm is already at TRUE: No need to test it again
493	IF ( ok_dgvm ) THEN
494	ind(i,j) = ind(i,j) * survive(j)
495	ENDIF
496
497	! fraction of plants that dies each day.
498	! exact formulation: light_death(i,j) = un - survive(j) / dt
499	light_death(i,j) = ( un - survive(j) ) / dt
500
501	ENDIF ! pft there and natural
502
503	ENDDO ! loop over pfts
504
505	ENDIF ! sumfpc > fpc_crit
506
507	ENDDO ! loop over grid points
508
509
510	!! 2.5 Recalculate fpc for natural PFTs
511	! Recalculate fpc on natural part of the grid cell for next light competition
512	DO j = 2,nvm ! loop over #PFT
513
514	!! 2.5.1 Natural PFTs
515	IF ( natural(j) ) THEN
516
517	!! 2.5.1.1 Trees
518	IF ( is_tree(j) ) THEN
519
520	DO i = 1, npts
521
522	!NVMODIF
523	! IF (lai(i,j) == val_exp) THEN
524	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
525	! ELSE
526	! veget_lastlight(i,j) = &
527	! cn_ind(i,j) * ind(i,j) * &
528	! MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
529	! ENDIF
530	!! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
531
532	IF (lai(i,j) == val_exp) THEN
533	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
534	ELSE
535	veget_lastlight(i,j) = &
536	cn_ind(i,j) * ind(i,j) * &
537	MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover )
538	ENDIF
539	ENDDO
540
541	ELSE
542
543	!! 2.5.1.2 Grasses
544	DO i = 1, npts
545
546	!NVMODIF
547	! IF (lai(i,j) == val_exp) THEN
548	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
549	! ELSE
550	! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
551	! ( un - exp( -lai(i,j) * ext_coeff(j) ) )
552	! ENDIF
553	!!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
554
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( - lm_lastyearmax(i,j) * sla(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
588	!! 3.1 XXX
589	WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate )
590	lai_ind(:) = sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) )
591	ELSEWHERE
592	lai_ind(:) = zero
593	ENDWHERE
594
595	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) * &
596	MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
597
598	WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
599
600	light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j))
601
602	ENDWHERE
603
604	!! 3.2 Update biomass and litter pools
605	DO m = 1,nelements
606	DO k=1,nparts
607
608	bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m)
609	biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m)
610
611	ENDDO
612	END DO
613
614	!! 3.3 Update number of individuals
615	ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
616
617	ENDIF
618	ENDDO
619
620	light_death(:,:) = light_death(:,:)/dt
621
622	ENDIF ! ok_dgvm
623
624
625	!! 4. Write history files
626	CALL xios_orchidee_send_field("LIGHT_DEATH",light_death)
627
628	CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
629	light_death, npts*nvm, horipft_index)
630
631	IF (printlev>=4) WRITE(numout,*) 'Leaving light'
632
633	END SUBROUTINE light
634
635	END MODULE lpj_light

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

Context Navigation

source: branches/publications/ORCHIDEE-LEAK-r5919/src_stomate/lpj_light.f90 @ 5925

Download in other formats: