Context Navigation

source: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/lpj_pftinout.f90 @ 7540

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

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

Download in other formats: