Context Navigation

source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/lpj_pftinout.f90 @ 5816

Last change on this file since 5816 was 5816, checked in by jinfeng.chang, 5 years ago
copy ORCHIDEE-GMv3.2 for publication
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 22.2 KB

Line
1	! =================================================================================================================================
2	! MODULE : lpj_pftinout
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 Introduce and eliminate PFT's from pixel
10	!!
11	!! \n DESCRIPTION: None
12	!!
13	!! RECENT CHANGE(S) : None
14	!!
15	!! REFERENCE(S) :
16	!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
17	!! plant geography and terrestrial carbon cycling in the LPJ dynamic
18	!! global vegetation model, Global Change Biology, 9, 161-185.\n
19	!! - Thonicke, K., S. Venevsky, et al. (2001), The role of fire disturbance
20	!! for global vegetation dynamics: coupling fire into a Dynamic Global
21	!! Vegetation Model, Global Ecology and Biogeography, 10, 661-677.\n
22	!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
23	!! terrestrial biosphere model based on ecophysiological constraints,
24	!! resource availability, and competition among plant functional types,
25	!! Global Biogeochemical Cycles, 10(4), 693-709.\n
26	!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
27	!! dynamics in the modelling of terrestrial ecosystems: comparing two
28	!! contrasting approaches within European climate space,
29	!! Global Ecology and Biogeography, 10, 621-637.\n
30	!!
31	!! SVN :
32	!! $HeadURL$
33	!! $Date$
34	!! $Revision$
35	!! \n
36	!_ ==============================================================================================================================
37
38	MODULE lpj_pftinout
39
40	! modules used:
41
42	USE ioipsl_para
43	USE stomate_data
44	USE pft_parameters
45	USE constantes
46	USE grid
47
48	IMPLICIT NONE
49
50	! private & public routines
51
52	PRIVATE
53	PUBLIC pftinout,pftinout_clear
54
55	LOGICAL, SAVE :: firstcall_pftinout = .TRUE. !! first call
56	!$OMP THREADPRIVATE(firstcall_pftinout)
57
58	CONTAINS
59
60
61	!! ================================================================================================================================
62	!! SUBROUTINE : pftinout_clear
63	!!
64	!>\BRIEF Set flag ::firstcall_pftinout to true and initialize the variables
65	!_ ================================================================================================================================
66
67	SUBROUTINE pftinout_clear
68	firstcall_pftinout = .TRUE.
69	END SUBROUTINE pftinout_clear
70
71	!! ================================================================================================================================
72	!! SUBROUTINE : pftinout
73	!!
74	!>\BRIEF Introduce and eliminate PFT's from pixel
75	!!
76	!! DESCRIPTION**3 : Introduction and elimination of PFTs on the basis of climate condition.
77	!! For natural and woody PFTs the foliage projected coverage is calculated as follows:
78	!! \latexonly
79	!! \input{equation_lpj_pftinout.tex}
80	!! \endlatexonly
81	!! \n
82	!! where FPC is foliage projective cover (::fpc_nat), CN crown area (::cn_ind,
83	!! @tex $ m^{2} $ @endtex), IND number of individuals (::ind, @tex $ m^{-2} $ @endtex,
84	!! FRAC total fraction occupied by natural vegetation (::fracnat),
85	!! @tex $ LM_{rm max} $ @endtex maximum leaf mass in last year
86	!! (::lm_lastyearmax, @tex $ g C m^{-2} $ @endtex), SLA specific leaf area (sla,
87	!! @tex $ m^{2} (g C)^{-1} $ @endtex), and coff coefficient (::ext_coeff). ::ext_coeff
88	!! describes a property of the canopy (i.e. law of Lambert-Beer) and is defined in **2
89	!!
90	!! The foliage projective cover feeds into the calculation of the space available for
91	!! expansion of existing and dispersion of new PFTs within a gridbox. In turn, available
92	!! space is use to calculate the number of individuals with a PFT.
93	!!
94	!! Saplings are introduced under the condition that winter temperature is
95	!! moderate, plant age is older than 1.25, (and for some PFTs at least one adjacent grid
96	!! box exists for expansion), new saplings are introduced for narural PFT. In the simulation of
97	!! agricultural grassland, if target PFT does not exist in the gridbox, it is introduced
98	!! regardless of climate condition. When a new PFT is introduced CO_2 is taken from the
99	!! atmosphere to account for CO_2 present in the seed and required by the germinated seeds
100	!! to establish a sapling. These initial phases in ontology are not accounted for. However,
101	!! by taking this small amount of CO2 from the atmosphere, mass balance closure for C is
102	!! preserved.
103	!!
104	!! PFTs are eliminated under the condition that they are no longer adapted to the critical
105	!! temperatures in winter. When a PFT is eliminated its number of indiviuals is set to zero and
106	!! the rest of the elimination process is taken care of in lpj_kill.f90.
107	!!
108	!! RECENT CHANGE(S) : None
109	!!
110	!! MAIN OUTPUT VARIABLE(S): :: avail_tree (space availability for trees, unitless),
111	!! :: avail_grass (space availability for grasses, unitless), :: biomass (biomass, \f$gC m^{-2}\f$)
112	!! and :: ind (density of individuals, \f$m^{-2}\f$)
113	!!
114	!! REFERENCE(S) : None
115	!!
116	!! FLOWCHART :
117	!! \latexonly
118	!! \includegraphics[scale = 0.6]{pftinout.png}
119	!! \endlatexonly
120	!! \n
121	!_ ================================================================================================================================
122
123
124
125
126
127
128	SUBROUTINE pftinout (npts, dt, adapted, regenerate, &
129	neighbours, veget_max, &
130	biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
131	PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
132	co2_to_bm, &
133	avail_tree, avail_grass, &
134	!gmjc
135	sla_calc)
136	!end gmjc
137
138	!! 0. Variable and parameter declaration
139
140	!! 0.1 Input variables
141
142	INTEGER(i_std), INTENT(in) :: npts !! Domain size - number of pixels (unitless)
143	REAL(r_std), INTENT(in) :: dt !! Time step of vegetation dynamics for stomate
144	!! (days)
145	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: adapted !! Winter not too cold (unitless)
146	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: regenerate !! Winter sufficiently cold (unitless)
147	INTEGER(i_std), DIMENSION(npts,NbNeighb), INTENT(in) :: neighbours !! Indices of the 8 neighbours of each grid point
148	!! (unitless); 1=North and then clockwise.
149	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max !! "maximal" coverage fraction of a PFT (LAI ->
150	!! infinity) on ground (unitless)
151	!gmjc
152	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: sla_calc
153	!end gmjc
154	!! 0.2 Output variables
155
156	REAL(r_std), DIMENSION(npts), INTENT(out) :: avail_tree !! Space availability for trees (unitless)
157	REAL(r_std), DIMENSION(npts), INTENT(out) :: avail_grass !! Space availability for grasses (unitless)
158
159
160	!! 0.3 Modified variables
161
162	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass !! Biomass (gC m^{-2})
163	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Density of individuals (m^{-2})
164	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind !! Crown area of individuals (m^2)
165	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! Mean age (years)
166	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! Fraction of leaves in leaf age class (unitless)
167	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity
168	!! (gC m^{-2} year^{-1})
169	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! Last year's maximum leaf mass, for each PFT
170	!! (gC m^{-2})
171	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! Plant senescent for deciduous trees; .FALSE.
172	!! if PFT is introduced or killed
173	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! PFT exists
174	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very
175	!! localized (unitless)
176	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the
177	!! growing season (days)
178	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: need_adjacent !! in order for this PFT to be introduced, does it
179	!! have to be present in an adjacent grid box?
180	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: RIP_time !! How much time ago was the PFT eliminated for
181	!! the last time (years)
182	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken (gC m^{-2} day^{-1})
183
184	!! 0.4 Local variables
185
186	REAL(r_std), DIMENSION(npts) :: avail !! availability
187	INTEGER(i_std) :: i,j,m !! indices
188	REAL(r_std), DIMENSION(npts) :: sumfrac_wood !! total woody vegetation cover
189	INTEGER(i_std), DIMENSION(npts) :: n_present !! number of adjacent grid cells where PFT is
190	!! ubiquitous
191	LOGICAL, DIMENSION(npts) :: can_introduce !! we can introduce this PFT
192	REAL(r_std), DIMENSION(npts) :: fracnat !! no real need for dimension(ntps) except for
193	!! vectorisation
194	!_ ================================================================================================================================
195
196	IF (printlev>=3) WRITE(numout,*) 'Entering pftinout'
197
198	!! 1. Messages
199
200	IF ( firstcall_pftinout ) THEN
201
202	WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
203
204	firstcall_pftinout = .FALSE.
205
206	ENDIF
207
208	!! 2. Total woody fpc and space avaibility on grid
209
210	! Only natural part of the grid cell\n
211	! S. Zaehle bug correction MERGE: need to subtract agricultural area!
212	! fraction of agricultural surface
213
214	!! 2.1 only natural PFT
215	fracnat(:) = un
216	DO j = 2,nvm ! Loop over # PFTs
217	IF ( .NOT. natural(j) ) THEN
218	fracnat(:) = fracnat(:) - veget_max(:,j)
219	ENDIF
220	ENDDO ! Loop over # PFTs
221
222	!! 2.2 Total woody fractional plant cover
223	sumfrac_wood(:) = zero
224	DO j = 2,nvm ! Loop over # PFTs
225
226	! S. Zaehle problem here: agriculture, not convinced that this representation of LPJ is correct
227	! if agriculture is present, ind must be recalculated to correspond to the natural density...
228	! since ind is per grid cell, can be achived by discounting for agricultura fraction
229	IF ( natural(j).AND.is_tree(j) ) THEN
230	WHERE(fracnat(:).GT.min_stomate)
231	sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) &
232	* ( un - exp( - lm_lastyearmax(:,j) * sla_calc(:,j) * ext_coeff(j) ) )
233	!lai changed to lm_last
234	ENDWHERE
235	ENDIF
236	ENDDO ! Loop over # PFTs
237
238	!! 2.3 Space availability
239	avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
240	avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
241
242	!! 3. Time since last elimination (y)
243
244	RIP_time = RIP_time + dt / one_year
245
246	!! 4. Agicultural PFTs
247
248	! Agricultural PFTs are only present if they are prescribed
249	DO j = 2,nvm ! Loop over # PFTs
250
251	IF ( .NOT. natural(j) ) THEN
252
253	IF (printlev>=4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
254
255	!! 4.1 Agricultural trees
256	! Agricultural trees are not treated for the moment
257	IF ( is_tree(j) ) THEN
258
259	CALL ipslerr_p(3,'pftinout','Agricultural trees not treated.','','')
260
261	!! 4.2 Initialization of agricultural grass lands
262	! Initialize parameter values of prescribed agricultural PFTs
263	ELSE
264
265	DO i = 1, npts ! Loop over # pixels - domain size
266
267	IF ( ( veget_max(i,j) .GT. min_stomate ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
268
269	! prescribed, but not yet there.
270	ind(i,j) = veget_max(i,j)
271	biomass(i,j,:,:) = bm_sapl(j,:,:) * ind(i,j) /veget_max(i,j)
272	co2_to_bm(i,j) = co2_to_bm(i,j) +SUM( biomass(i,j,:,icarbon) ) / dt
273	PFTpresent(i,j) = .TRUE.
274	everywhere(i,j) = un
275	senescence(i,j) = .FALSE.
276	age(i,j) = zero
277
278	ENDIF ! prescribed, but PFT not yet present
279
280	ENDDO ! Loop over # pixels - domain size
281
282	ENDIF
283
284	ENDIF ! not natural
285
286	ENDDO ! Loop over # PFTs
287
288	!! 5 Eliminate PFTs
289
290	DO j = 2,nvm ! Loop over # PFTs
291
292	! only for natural PFTs
293	IF ( natural(j) ) THEN
294
295	! Number of individuals are set to zero in the condition of cold winter
296	! 'adapted_crit' critical value for being adapted = 1.-(1./euler); see 'stomate_constants.f90'
297	WHERE ( PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
298
299	! PFT there, but not adapted any more (ex: winter too cold): kill
300	! set number of individuals to zero - rest will be done in lpj_kill
301	ind(:,j) = zero
302
303	ENDWHERE
304
305	ENDIF ! natural
306
307	ENDDO ! Loop over # PFTs
308
309	!! 6. Introduce PFTs
310
311	DO j = 2,nvm ! Loop over # PFTs
312
313	IF ( natural(j) ) THEN
314
315	! space availability for this PFT
316	IF ( is_tree(j) ) THEN
317	avail(:) = avail_tree(:)
318	ELSE
319	avail(:) = avail_grass(:)
320	ENDIF
321
322	!! 6.1 Check if PFT not present but (adapted and regenerative)
323	can_introduce(:) = .FALSE.
324
325	IF ( NbNeighb /= 8 ) THEN
326	CALL ipslerr(3, "pftinout", "This routine needs to be adapted to non rectengular grids", &
327	& "Talk to Jan Polcher", " ")
328	ENDIF
329
330	DO i = 1, npts ! Loop over # pixels - domain size
331
332	IF ( .NOT. PFTpresent(i,j) .AND. &
333	( adapted(i,j) .GT. adapted_crit ) .AND. &
334	( regenerate(i,j) .GT. regenerate_crit ) ) THEN
335
336	! Seed are available nearby
337	IF ( need_adjacent(i,j) ) THEN
338
339	!! 6.1.1 Climate allows introduction of the PFT but dispersion requires the
340	! presence of seeds. Seed are considered available if at least one
341	! neighbouring pixel is entirely invaded by the PFT. If that condition is
342	! satisfied, the PFT can establish in the new pixel.
343	! Count number of totally invaded neighbours.
344	! no loop so that it can vectorize
345	n_present(i) = 0
346	IF ( neighbours(i,1) .GT. 0 ) THEN
347	IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
348	n_present(i) = n_present(i)+1
349	ENDIF
350	ENDIF
351	IF ( neighbours(i,3) .GT. 0 ) THEN
352	IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
353	n_present(i) = n_present(i)+1
354	ENDIF
355	ENDIF
356	IF ( neighbours(i,5) .GT. 0 ) THEN
357	IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
358	n_present(i) = n_present(i)+1
359	ENDIF
360	ENDIF
361	IF ( neighbours(i,7) .GT. 0 ) THEN
362	IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
363	n_present(i) = n_present(i)+1
364	ENDIF
365	ENDIF
366
367	IF ( n_present(i) .GT. 0 ) THEN
368
369	! PFT is ubiquitous in at least one adjacent grid box
370	can_introduce(i) = .TRUE.
371
372	ENDIF
373
374	ELSE
375
376	!! 6.1.2 No seed (trees) required for dispersion
377	! The PFT can establish without the presence of seed trees in
378	! neighbouring pixels.
379	can_introduce(i) = .TRUE.
380
381	ENDIF ! do we have to look at the neighbours?
382
383	ENDIF ! we'd like to introduce the PFT
384
385	ENDDO ! Loop over # pixels - domain size
386
387	!! 6.2 Has the PFT been eliminated lately?
388	! Additional test whether the PFT has been eliminated lately, i.e.
389	! less than 1.25 years ago. Do not only take full years as success of
390	! introduction, as introduction might depend on season.
391	WHERE ( RIP_time(:,j) .LT. RIP_time_min )
392
393	! PFT was eliminated lately - cannot reintroduce
394	can_introduce(:) = .FALSE.
395
396	ENDWHERE
397
398	!! 6.3 Introduce that PFT where possible
399	! "can_introduce" means that it either exists in neighbouring grid boxes
400	! or that we do not look at neighbours, that it has not been eliminated
401	! lately, and, of course, that the climate is good for that PFT.
402	WHERE ( can_introduce(:) )
403
404	PFTpresent(:,j) = .TRUE.
405
406	senescence(:,j) = .FALSE.
407
408	! introduce at least a few saplings, even if canopy is closed
409	! initial density of individuals (ind_0) = 0.02, see 'stomate_constant.f90'
410	ind(:,j) = ind_0 * (dt/one_year) * avail(:)
411
412	WHERE(veget_max(:,j) .GT. min_stomate)
413	biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j) /veget_max(:,j)
414	biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j) /veget_max(:,j)
415	biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)/veget_max(:,j)
416	biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)/veget_max(:,j)
417	biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)/veget_max(:,j)
418	biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)/veget_max(:,j)
419	biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)/veget_max(:,j)
420	biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)/veget_max(:,j)
421	ELSEWHERE
422	biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
423	biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j)
424	biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)
425	biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)
426	biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)
427	biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)
428	biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)
429	biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)
430	END WHERE
431
432	co2_to_bm(:,j) = &
433	co2_to_bm(:,j) + &
434	( biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
435	biomass(:,j,isapbelow,icarbon) + biomass(:,j,iheartabove,icarbon) + &
436	biomass(:,j,iheartbelow,icarbon) + biomass(:,j,iroot,icarbon) + &
437	biomass(:,j,ifruit,icarbon) + biomass(:,j,icarbres,icarbon) )/dt
438
439	when_growthinit(:,j) = large_value
440
441	age(:,j) = zero
442
443	! all leaves are young
444	leaf_frac(:,j,1) = un
445
446	! non-zero "long term" npp and last year's leaf mass for saplings -
447	! so they won't be killed off by gap or kill
448	npp_longterm(:,j) = npp_longterm_init
449
450	lm_lastyearmax(:,j) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
451
452	ENDWHERE ! we can introduce the PFT
453
454	!! 6.4 Expansion of the PFT within the grid box
455	! PFT expansion/dispersion to a new grid box should not be confused with
456	! expansion in areal coverage
457	IF ( treat_expansion ) THEN
458
459	WHERE ( can_introduce(:) )
460
461	! low value at the beginning
462	everywhere(:,j) = everywhere_init
463	ENDWHERE
464
465	ELSE
466
467	! expansion is not treated
468	WHERE ( can_introduce(:) )
469	everywhere(:,j) = un
470	ENDWHERE
471
472	ENDIF ! treat expansion
473
474	ENDIF ! only natural PFTs
475
476	ENDDO ! Loop over # PFTs
477
478	!! 7. If a PFT has been present once in a grid box, we suppose that it will survive
479
480	! If a PFT has been present once in a grid box, we suppose that it will survive
481	! in isolated places (e.g., an oasis) within that grid box, even if it gets
482	! officially eliminated from it later. That means that if climate becomes favorable
483	! again, it will not need to get seeds from adjacent grid cells.
484	WHERE ( PFTpresent )
485	need_adjacent = .FALSE.
486	ENDWHERE
487
488	IF (printlev>=4) WRITE(numout,*) 'Leaving pftinout'
489
490	END SUBROUTINE pftinout
491
492	END MODULE lpj_pftinout

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

Download in other formats: