Context Navigation

lpj_light.f90 @ 8066

Last change on this file since 8066 was 6849, checked in by yidi.xu, 4 years ago
ORCHIDEE-MICT-OP for oil palm growth modelling
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 29.7 KB

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

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

Context Navigation

source: branches/publications/ORCHIDEE-MICT-OP-r6850/src_stomate/lpj_light.f90 @ 8066

Download in other formats: