Context Navigation

lpj_pftinout.f90 @ 6737

Last change on this file since 6737 was 4719, checked in by albert.jornet, 7 years ago

Merge: from revisions [4491:4695/trunk/ORCHIDEE]

Merge done in [4671:4718/perso/albert.jornet/MICT_MERGE]

Property svn:keywords set to HeadURL Date Author Revision

File size: 22.4 KB

Line
1	! =================================================================================================================================
2	! MODULE : lpj_pftinout
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 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_cov_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_cov_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) .OR. pasture(j)) THEN
218	fracnat(:) = fracnat(:) - veget_cov_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	!JCMODIF
233	! * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
234	* ( un - exp( - lm_lastyearmax(:,j) * sla_calc(:,j) * ext_coeff(j) ) )
235	!ENDJCMODIF
236	!lai changed to lm_last
237	ENDWHERE
238	ENDIF
239	ENDDO ! Loop over # PFTs
240
241	!! 2.3 Space availability
242	avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
243	avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
244
245	!! 3. Time since last elimination (y)
246
247	RIP_time = RIP_time + dt / one_year
248
249	!! 4. Agicultural PFTs
250
251	! Agricultural PFTs are only present if they are prescribed
252	DO j = 2,nvm ! Loop over # PFTs
253
254	IF ( .NOT. natural(j) .OR. pasture(j)) THEN
255
256	IF (printlev>=4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
257
258	!! 4.1 Agricultural trees
259	! Agricultural trees are not treated for the moment
260	IF ( is_tree(j) ) THEN
261
262	CALL ipslerr_p(3,'pftinout','Agricultural trees not treated.','','')
263
264	!! 4.2 Initialization of agricultural grass lands
265	! Initialize parameter values of prescribed agricultural PFTs
266	ELSE
267
268	DO i = 1, npts ! Loop over # pixels - domain size
269
270	IF ( ( veget_cov_max(i,j) .GT. min_stomate ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
271
272	! prescribed, but not yet there.
273	ind(i,j) = veget_cov_max(i,j)
274	biomass(i,j,:,:) = bm_sapl(j,:,:) * ind(i,j) /veget_cov_max(i,j)
275	co2_to_bm(i,j) = co2_to_bm(i,j) +SUM( biomass(i,j,:,icarbon) ) / dt
276	PFTpresent(i,j) = .TRUE.
277	everywhere(i,j) = un
278	senescence(i,j) = .FALSE.
279	age(i,j) = zero
280
281	ENDIF ! prescribed, but PFT not yet present
282
283	ENDDO ! Loop over # pixels - domain size
284
285	ENDIF
286
287	ENDIF ! not natural
288
289	ENDDO ! Loop over # PFTs
290
291	!! 5 Eliminate PFTs
292
293	DO j = 2,nvm ! Loop over # PFTs
294
295	! only for natural PFTs
296	IF ( natural(j) .AND. .NOT. pasture(j)) THEN
297
298	! Number of individuals are set to zero in the condition of cold winter
299	! 'adapted_crit' critical value for being adapted = 1.-(1./euler); see 'stomate_constants.f90'
300	WHERE ( PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
301
302	! PFT there, but not adapted any more (ex: winter too cold): kill
303	! set number of individuals to zero - rest will be done in lpj_kill
304	ind(:,j) = zero
305
306	ENDWHERE
307
308	ENDIF ! natural
309
310	ENDDO ! Loop over # PFTs
311
312	!! 6. Introduce PFTs
313
314	DO j = 2,nvm ! Loop over # PFTs
315
316	IF ( natural(j) .AND. .NOT. pasture(j)) THEN
317
318	! space availability for this PFT
319	IF ( is_tree(j) ) THEN
320	avail(:) = avail_tree(:)
321	ELSE
322	avail(:) = avail_grass(:)
323	ENDIF
324
325	!! 6.1 Check if PFT not present but (adapted and regenerative)
326	can_introduce(:) = .FALSE.
327
328	IF ( NbNeighb /= 8 ) THEN
329	CALL ipslerr(3, "pftinout", "This routine needs to be adapted to non rectengular grids", &
330	& "Talk to Jan Polcher", " ")
331	ENDIF
332
333	DO i = 1, npts ! Loop over # pixels - domain size
334
335	IF ( .NOT. PFTpresent(i,j) .AND. &
336	( adapted(i,j) .GT. adapted_crit ) .AND. &
337	( regenerate(i,j) .GT. regenerate_crit ) ) THEN
338
339	! Seed are available nearby
340	IF ( need_adjacent(i,j) ) THEN
341
342	!! 6.1.1 Climate allows introduction of the PFT but dispersion requires the
343	! presence of seeds. Seed are considered available if at least one
344	! neighbouring pixel is entirely invaded by the PFT. If that condition is
345	! satisfied, the PFT can establish in the new pixel.
346	! Count number of totally invaded neighbours.
347	! no loop so that it can vectorize
348	n_present(i) = 0
349	IF ( neighbours(i,1) .GT. 0 ) THEN
350	IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
351	n_present(i) = n_present(i)+1
352	ENDIF
353	ENDIF
354	IF ( neighbours(i,3) .GT. 0 ) THEN
355	IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
356	n_present(i) = n_present(i)+1
357	ENDIF
358	ENDIF
359	IF ( neighbours(i,5) .GT. 0 ) THEN
360	IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
361	n_present(i) = n_present(i)+1
362	ENDIF
363	ENDIF
364	IF ( neighbours(i,7) .GT. 0 ) THEN
365	IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
366	n_present(i) = n_present(i)+1
367	ENDIF
368	ENDIF
369
370	IF ( n_present(i) .GT. 0 ) THEN
371
372	! PFT is ubiquitous in at least one adjacent grid box
373	can_introduce(i) = .TRUE.
374
375	ENDIF
376
377	ELSE
378
379	!! 6.1.2 No seed (trees) required for dispersion
380	! The PFT can establish without the presence of seed trees in
381	! neighbouring pixels.
382	can_introduce(i) = .TRUE.
383
384	ENDIF ! do we have to look at the neighbours?
385
386	ENDIF ! we'd like to introduce the PFT
387
388	ENDDO ! Loop over # pixels - domain size
389
390	!! 6.2 Has the PFT been eliminated lately?
391	! Additional test whether the PFT has been eliminated lately, i.e.
392	! less than 1.25 years ago. Do not only take full years as success of
393	! introduction, as introduction might depend on season.
394	WHERE ( RIP_time(:,j) .LT. RIP_time_min )
395
396	! PFT was eliminated lately - cannot reintroduce
397	can_introduce(:) = .FALSE.
398
399	ENDWHERE
400
401	!! 6.3 Introduce that PFT where possible
402	! "can_introduce" means that it either exists in neighbouring grid boxes
403	! or that we do not look at neighbours, that it has not been eliminated
404	! lately, and, of course, that the climate is good for that PFT.
405	WHERE ( can_introduce(:) )
406
407	PFTpresent(:,j) = .TRUE.
408
409	senescence(:,j) = .FALSE.
410
411	! introduce at least a few saplings, even if canopy is closed
412	! initial density of individuals (ind_0) = 0.02, see 'stomate_constant.f90'
413	ind(:,j) = ind_0 * (dt/one_year) * avail(:)
414
415	WHERE(veget_cov_max(:,j) .GT. min_stomate)
416	biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j) /veget_cov_max(:,j)
417	biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j) /veget_cov_max(:,j)
418	biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)/veget_cov_max(:,j)
419	biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)/veget_cov_max(:,j)
420	biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)/veget_cov_max(:,j)
421	biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)/veget_cov_max(:,j)
422	biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)/veget_cov_max(:,j)
423	biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)/veget_cov_max(:,j)
424	ELSEWHERE
425	biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
426	biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j)
427	biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)
428	biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)
429	biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)
430	biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)
431	biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)
432	biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)
433	END WHERE
434
435	co2_to_bm(:,j) = &
436	co2_to_bm(:,j) + &
437	( biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
438	biomass(:,j,isapbelow,icarbon) + biomass(:,j,iheartabove,icarbon) + &
439	biomass(:,j,iheartbelow,icarbon) + biomass(:,j,iroot,icarbon) + &
440	biomass(:,j,ifruit,icarbon) + biomass(:,j,icarbres,icarbon) )/dt
441
442	when_growthinit(:,j) = large_value
443
444	age(:,j) = zero
445
446	! all leaves are young
447	leaf_frac(:,j,1) = un
448
449	! non-zero "long term" npp and last year's leaf mass for saplings -
450	! so they won't be killed off by gap or kill
451	npp_longterm(:,j) = npp_longterm_init
452
453	lm_lastyearmax(:,j) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
454
455	ENDWHERE ! we can introduce the PFT
456
457	!! 6.4 Expansion of the PFT within the grid box
458	! PFT expansion/dispersion to a new grid box should not be confused with
459	! expansion in areal coverage
460	IF ( treat_expansion ) THEN
461
462	WHERE ( can_introduce(:) )
463
464	! low value at the beginning
465	everywhere(:,j) = everywhere_init
466	ENDWHERE
467
468	ELSE
469
470	! expansion is not treated
471	WHERE ( can_introduce(:) )
472	everywhere(:,j) = un
473	ENDWHERE
474
475	ENDIF ! treat expansion
476
477	ENDIF ! only natural PFTs
478
479	ENDDO ! Loop over # PFTs
480
481	!! 7. If a PFT has been present once in a grid box, we suppose that it will survive
482
483	! If a PFT has been present once in a grid box, we suppose that it will survive
484	! in isolated places (e.g., an oasis) within that grid box, even if it gets
485	! officially eliminated from it later. That means that if climate becomes favorable
486	! again, it will not need to get seeds from adjacent grid cells.
487	WHERE ( PFTpresent )
488	need_adjacent = .FALSE.
489	ENDWHERE
490
491	IF (printlev>=4) WRITE(numout,*) 'Leaving pftinout'
492
493	END SUBROUTINE pftinout
494
495	END MODULE lpj_pftinout

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

Context Navigation

source: branches/publications/ORCHIDEE_GLUC_r6545/src_stomate/lpj_pftinout.f90 @ 6737

Download in other formats: