Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_light.f90 @ 107

Last change on this file since 107 was 64, checked in by didier.solyga, 14 years ago
Import first version of ORCHIDEE_EXT
File size: 15.3 KB

Line
1	! Light competition
2	!
3	! If canopy is almost closed (fpc > fpc_crit), then trees outcompete grasses.
4	! fpc_crit is normally fpc_crit.
5	! Here, fpc ("foilage protected cover") also takes into account the minimum fraction
6	! of space covered by trees through branches etc. This is done to prevent strong relative
7	! changes of fpc from one day to another for deciduous trees at the beginning of their
8	! growing season, which would yield to strong cutbacks (see 3.2.1.1.2)
9	! No competition between woody pfts (height of individuals is not considered) !
10	! Exception: when one woody pft is overwhelming (i.e. fpc > fpc_crit). In that
11	! case, eliminate all other woody pfts and reduce dominant pft to fpc_crit.
12	! Age of individuals is not considered. In reality, light competition would more
13	! easily kill young individuals, thus increasing the mean age of the stand.
14	! Exclude agricultural pfts from competition
15	!
16	! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_light.f90,v 1.8 2009/01/06 15:01:25 ssipsl Exp $
17	! IPSL (2006)
18	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
19	!
20	MODULE lpj_light
21
22	! modules used:
23
24	USE ioipsl
25	USE constantes
26	USE stomate_data
27
28	IMPLICIT NONE
29
30	! private & public routines
31
32	PRIVATE
33	PUBLIC light, light_clear
34
35	! first call
36	LOGICAL, SAVE :: firstcall = .TRUE.
37
38	CONTAINS
39
40	SUBROUTINE light_clear
41	firstcall=.TRUE.
42	END SUBROUTINE light_clear
43
44	SUBROUTINE light (npts, dt, &
45	PFTpresent, cn_ind, lai, maxfpc_lastyear, &
46	ind, biomass, veget_lastlight, bm_to_litter)
47
48	!
49	! 0 declarations
50	!
51
52	! 0.1 input
53
54	! Domain size
55	INTEGER(i_std), INTENT(in) :: npts
56	! Time step (days)
57	REAL(r_std), INTENT(in) :: dt
58	! Is pft there
59	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent
60	! crown area of individuals (m**2)
61	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind
62	! leaf area index OF AN INDIVIDUAL PLANT
63	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai
64	! last year's maximum fpc for each natural PFT, on ground
65	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear
66
67	! 0.2 modified fields
68
69	! Number of individuals / m2
70	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind
71	! biomass (gC/(m**2 of ground))
72	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass
73	! Vegetation cover after last light competition
74	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_lastlight
75	! biomass taken away (gC/m**2)
76	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: bm_to_litter
77
78	! 0.3 local
79
80	! index
81	INTEGER(i_std) :: i,j
82	! total natural fpc
83	REAL(r_std), DIMENSION(npts) :: sumfpc
84	! total natural woody fpc
85	REAL(r_std) :: sumfpc_wood
86	! change in total woody fpc
87	REAL(r_std) :: sumdelta_fpc_wood
88	! maximum wood fpc
89	REAL(r_std) :: maxfpc_wood
90	! which woody pft is maximum
91	INTEGER(i_std) :: optpft_wood
92	! total natural grass fpc
93	REAL(r_std) :: sumfpc_grass
94	! this year's foliage protected cover on natural part of the grid cell
95	REAL(r_std), DIMENSION(npts,nvm) :: fpc_nat
96	! fpc change within last year
97	REAL(r_std), DIMENSION(nvm) :: deltafpc
98	! Relative change of number of individuals for trees
99	REAL(r_std) :: reduct
100	! Fraction of plants that survive
101	REAL(r_std), DIMENSION(nvm) :: survive
102	! number of grass PFTs present in the grid box
103	INTEGER(i_std) :: num_grass
104	! New total grass fpc
105	REAL(r_std) :: sumfpc_grass2
106	! fraction of plants that dies each day (1/day)
107	REAL(r_std), DIMENSION(npts,nvm) :: light_death
108
109	! =========================================================================
110
111	IF (bavard.GE.3) WRITE(numout,*) 'Entering light'
112
113	!
114	! 1 first call
115	!
116
117	IF ( firstcall ) THEN
118
119	WRITE(numout,*) 'light:'
120
121	WRITE(numout,*) ' > Maximum total number of grass individuals in'
122	WRITE(numout,*) ' a closed canopy: ', grass_mercy
123
124	WRITE(numout,*) ' > Minimum fraction of trees that survive even in'
125	WRITE(numout,*) ' a closed canopy: ', tree_mercy
126
127	WRITE(numout,*) ' > For trees, minimum fraction of crown area covered'
128	WRITE(numout,*) ' (due to its branches etc.)', min_cover
129
130	WRITE(numout,*) ' > for diagnosis of fpc increase, compare today''s fpc'
131	IF ( annual_increase ) THEN
132	WRITE(numout,*) ' to last year''s maximum.'
133	ELSE
134	WRITE(numout,*) ' to fpc of the last time step.'
135	ENDIF
136
137	firstcall = .FALSE.
138
139	ENDIF
140
141	!
142	! 2 fpc characteristics
143	!
144
145	!
146	! 2.1 calculate fpc on natural part of grid cell.
147	!
148
149	DO j = 2, nvm
150
151	IF ( natural(j) ) THEN
152
153	! 2.1.1 natural PFTs
154
155	IF ( tree(j) ) THEN
156
157	! 2.1.1.1 trees: minimum cover due to stems, branches etc.
158
159	DO i = 1, npts
160	IF (lai(i,j) == val_exp) THEN
161	fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
162	ELSE
163	fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
164	MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
165	ENDIF
166	ENDDO
167
168	ELSE
169
170	! 2.1.1.2 bare ground
171	IF (j == ibare_sechiba) THEN
172	fpc_nat(:,j) = cn_ind(:,j) * ind(:,j)
173
174	! 2.1.1.3 grasses
175	ELSE
176	DO i = 1, npts
177	IF (lai(i,j) == val_exp) THEN
178	fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
179	ELSE
180	fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
181	( un - exp( -lai(i,j) * ext_coeff(j) ) )
182	ENDIF
183	ENDDO
184	ENDIF
185	ENDIF ! tree/grass
186
187	ELSE
188
189	! 2.1.2 agricultural PFTs: not present on natural part
190
191	fpc_nat(:,j) = 0.0
192
193	ENDIF ! natural/agricultural
194
195	ENDDO
196
197	!
198	! 2.2 sum natural fpc for every grid point
199	!
200
201	sumfpc(:) = zero
202	DO j = 2,nvm
203	!SZ bug correction MERGE: need to subtract agricultural area!
204	sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
205	ENDDO
206
207	!
208	! 3 Light competition
209	!
210
211	light_death(:,:) = 0.0
212
213	DO i = 1, npts ! SZ why this loop and not a vector statement ?
214
215	! Only if vegetation cover is dense
216
217	IF ( sumfpc(i) .GT. fpc_crit ) THEN
218
219	! fpc change for each pft
220	! There are two possibilities: either we compare today's fpc with the fpc after the last
221	! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
222	! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
223	! As for trees, the cutback is proportional to this increase, this means that seasonal trees
224	! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its
225	! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
226
227	IF ( annual_increase ) THEN
228	deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero )
229	ELSE
230	deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero )
231	ENDIF
232
233	! default: survive
234
235	survive(:) = 1.0
236
237	!
238	! 3.1 determine some characteristics of the fpc distribution
239	!
240
241	sumfpc_wood = 0.0
242	sumdelta_fpc_wood = 0.0
243	maxfpc_wood = 0.0
244	optpft_wood = 0
245	sumfpc_grass = 0.0
246	num_grass = 0
247
248	DO j = 2,nvm
249
250	! only natural pfts
251
252	IF ( natural(j) ) THEN
253
254	IF ( tree(j) ) THEN
255
256	! trees
257
258	! total woody fpc
259
260	sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
261
262	! how much did the woody fpc increase
263
264	sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
265
266	! which woody pft is preponderant
267
268	IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
269
270	optpft_wood = j
271
272	maxfpc_wood = fpc_nat(i,j)
273
274	ENDIF
275
276	ELSE
277
278	! grasses
279
280	! total (natural) grass fpc
281
282	sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
283
284	! number of grass PFTs present in the grid box
285
286	IF ( PFTpresent(i,j) ) THEN
287	num_grass = num_grass + 1
288	ENDIF
289
290	ENDIF ! tree or grass
291
292	ENDIF ! natural
293
294	ENDDO ! loop over pfts
295
296	!
297	! 3.2 light competition: assume wood outcompetes grass
298	!
299
300	IF (sumfpc_wood .GE. fpc_crit ) THEN
301
302	!
303	! 3.2.1 all allowed natural space is covered by wood:
304	! cut back trees to fpc_crit.
305	! Original DGVM: kill grasses. Modified: we let a very
306	! small fraction of grasses survive.
307	!
308
309	DO j = 2,nvm
310
311	! only present and natural pfts compete
312
313	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
314
315	IF ( tree(j) ) THEN
316
317	!
318	! 3.2.1.1 tree
319	!
320
321	IF ( maxfpc_wood .GE. fpc_crit ) THEN
322
323	! 3.2.1.1.1 one single woody pft is overwhelming
324
325	IF ( j .eq. optpft_wood ) THEN
326
327	! reduction for this dominant pft
328
329	reduct = 1. - fpc_crit / fpc_nat(i,j)
330
331	ELSE
332
333	! strongly reduce all other woody pfts
334	! (original DGVM: tree_mercy = 0.0 )
335
336	reduct = 1. - tree_mercy
337
338	ENDIF ! pft = dominant woody pft
339
340	ELSE
341
342	! 3.2.1.1.2 no single woody pft is overwhelming
343	! (original DGVM: tree_mercy = 0.0 )
344	! The reduction rate is proportional to the ratio deltafpc/fpc.
345
346	IF ( fpc_nat(i,j) .GE. min_stomate ) THEN
347
348	reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
349	(sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
350	( un - tree_mercy ) )
351
352	ELSE
353
354	! tree fpc didn't icrease or it started from nothing
355
356	reduct = 0.
357
358	ENDIF
359
360	ENDIF ! maxfpc_wood > fpc_crit
361
362	survive(j) = 1. - reduct
363
364	ELSE
365
366	!
367	! 3.2.1.2 grass: let a very small fraction survive (the sum of all
368	! grass individuals may make up a maximum cover of
369	! grass_mercy [for lai -> infinity]).
370	! In the original DGVM, grasses were killed in that case,
371	! corresponding to grass_mercy = 0.
372	!
373
374	survive(j) = ( grass_mercy / REAL( num_grass,r_std ) ) / ind(i,j)
375
376	survive(j) = MIN( un, survive(j) )
377
378	ENDIF ! tree or grass
379
380	ENDIF ! pft there and natural
381
382	ENDDO ! loop over pfts
383
384	ELSE
385
386	!
387	! 3.2.2 not too much wood so that grasses can subsist
388	!
389
390	! new total grass fpc
391	sumfpc_grass2 = fpc_crit - sumfpc_wood
392
393	DO j = 2,nvm
394
395	! only present and natural PFTs compete
396
397	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
398
399	IF ( tree(j) ) THEN
400
401	! no change for trees
402
403	survive(j) = 1.0
404
405	ELSE
406
407	! grass: fractional loss is the same for all grasses
408
409	IF ( sumfpc_grass .GT. min_stomate ) THEN
410	survive(j) = sumfpc_grass2 / sumfpc_grass
411	ELSE
412	survive(j)= 0.0
413	ENDIF
414
415	ENDIF
416
417	ENDIF ! pft there and natural
418
419	ENDDO ! loop over pfts
420
421	ENDIF ! sumfpc_wood > fpc_crit
422
423	!
424	! 3.3 update output variables
425	!
426
427	DO j = 2,nvm
428
429	IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
430
431	bm_to_litter(i,j,:) = bm_to_litter(i,j,:) + &
432	biomass(i,j,:) * ( 1. - survive(j) )
433
434	biomass(i,j,:) = biomass(i,j,:) * survive(j)
435
436	IF ( control%ok_dgvm ) THEN
437	ind(i,j) = ind(i,j) * survive(j)
438	ENDIF
439
440	! fraction of plants that dies each day.
441	! exact formulation: light_death(i,j) = 1. - survive(j) ** (1/dt)
442	light_death(i,j) = ( 1. - survive(j) ) / dt
443
444	ENDIF ! pft there and natural
445
446	ENDDO ! loop over pfts
447
448	ENDIF ! sumfpc > fpc_crit
449
450	ENDDO ! loop over grid points
451
452	!
453	! 4 recalculate fpc on natural part of grid cell (for next light competition)
454	!
455
456	DO j = 2,nvm
457
458	IF ( natural(j) ) THEN
459
460	!
461	! 4.1 natural PFTs
462	!
463
464	IF ( tree(j) ) THEN
465
466	! 4.1.1 trees: minimum cover due to stems, branches etc.
467
468	DO i = 1, npts
469	IF (lai(i,j) == val_exp) THEN
470	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
471	ELSE
472	veget_lastlight(i,j) = &
473	cn_ind(i,j) * ind(i,j) * &
474	MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
475	ENDIF
476	ENDDO
477
478	ELSE
479
480	! 4.1.2 grasses
481	DO i = 1, npts
482	IF (lai(i,j) == val_exp) THEN
483	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
484	ELSE
485	veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
486	( 1. - exp( -lai(i,j) * ext_coeff(j) ) )
487	ENDIF
488	ENDDO
489	ENDIF ! tree/grass
490
491	ELSE
492
493	!
494	! 4.2 agricultural PFTs: not present on natural part
495	!
496
497	veget_lastlight(:,j) = 0.0
498
499	ENDIF ! natural/agricultural
500
501	ENDDO
502
503	!
504	! 5 history
505	!
506
507	CALL histwrite (hist_id_stomate, 'LIGHT_DEATH', itime, &
508	light_death, npts*nvm, horipft_index)
509
510	IF (bavard.GE.4) WRITE(numout,*) 'Leaving light'
511
512	END SUBROUTINE light
513
514	END MODULE lpj_light

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

Download in other formats: