Context Navigation

source: tags/ORCHIDEE/src_stomate/lpj_pftinout.f90 @ 6

Last change on this file since 6 was 6, checked in by orchidee, 14 years ago
import first tag equivalent to CVS orchidee_1_9_5 + OOL_1_9_5
File size: 13.7 KB

Line
1	! throw out respectively introduce some PFTS
2	!
3	! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_pftinout.f90,v 1.9 2010/04/06 15:44:01 ssipsl Exp $
4	! IPSL (2006)
5	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
6	!
7	MODULE lpj_pftinout
8
9	! modules used:
10
11	USE ioipsl
12	USE stomate_constants
13	USE constantes_veg
14
15	IMPLICIT NONE
16
17	! private & public routines
18
19	PRIVATE
20	PUBLIC pftinout,pftinout_clear
21
22	! first call
23	LOGICAL, SAVE :: firstcall = .TRUE.
24
25	CONTAINS
26
27
28	SUBROUTINE pftinout_clear
29	firstcall = .TRUE.
30	END SUBROUTINE pftinout_clear
31
32	SUBROUTINE pftinout (npts, dt, adapted, regenerate, &
33	neighbours, veget, veget_max, &
34	biomass, ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
35	PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
36	co2_to_bm, &
37	avail_tree, avail_grass)
38
39	!
40	! 0 declarations
41	!
42
43	! 0.1 input
44
45	! Domain size
46	INTEGER(i_std), INTENT(in) :: npts
47	! Time step (days)
48	REAL(r_std), INTENT(in) :: dt
49	! Winter not too cold
50	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: adapted
51	! Winter sufficiently cold
52	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: regenerate
53	! indices of the 8 neighbours of each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
54	INTEGER(i_std), DIMENSION(npts,8), INTENT(in) :: neighbours
55	! fractional coverage on ground, taking into
56	! account LAI (=grid-scale fpc)
57	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget
58	! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
59	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max
60
61	! 0.2 modified fields
62
63	! biomass (gC/(m**2 of ground))
64	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass
65	! density of individuals 1/m**2
66	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind
67	! mean age (years)
68	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age
69	! fraction of leaves in leaf age class
70	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
71	! "long term" net primary productivity (gC/(m**2 of ground)/year)
72	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm
73	! last year's maximum leaf mass, for each PFT (gC/(m**2 of ground))
74	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax
75	! is the plant senescent? (only for deciduous trees - carbohydrate reserve)
76	! set to .FALSE. if PFT is introduced or killed
77	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence
78	! PFT exists
79	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent
80	! is the PFT everywhere in the grid box or very localized (after its introduction)
81	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere
82	! how many days ago was the beginning of the growing season
83	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit
84	! in order for this PFT to be introduced, does it have to be present in an
85	! adjacent grid box?
86	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: need_adjacent
87	! How much time ago was the PFT eliminated for the last time (y)
88	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: RIP_time
89	! biomass uptaken (gC/(m**2 of total ground)/day)
90	!NV passage 2D
91	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm
92
93	! 0.3 output
94
95	! space availability for trees
96	REAL(r_std), DIMENSION(npts), INTENT(out) :: avail_tree
97	! space availability for grasses
98	REAL(r_std), DIMENSION(npts), INTENT(out) :: avail_grass
99
100	! 0.4 local
101
102	! minimum availability
103	REAL(r_std), PARAMETER :: min_avail = 0.01
104	! availability
105	REAL(r_std), DIMENSION(npts) :: avail
106	! indices
107	INTEGER(i_std) :: i,j
108	! total woody vegetation cover
109	REAL(r_std), DIMENSION(npts) :: sumfrac_wood
110	! number of adjacent grid cells where PFT is ubiquitious
111	INTEGER(i_std), DIMENSION(npts) :: n_present
112	! we can introduce this PFT
113	LOGICAL, DIMENSION(npts) :: can_introduce
114
115	! =========================================================================
116
117	IF (bavard.GE.3) WRITE(numout,*) 'Entering pftinout'
118
119	!
120	! 1 Messages
121	!
122
123	IF ( firstcall ) THEN
124
125	WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
126
127	firstcall = .FALSE.
128
129	ENDIF
130
131	!
132	! 2 Space availability
133	!
134
135	! need to know total woody vegetation fraction
136
137	sumfrac_wood(:) = zero
138
139	DO j = 2,nvm
140
141	IF ( tree(j) ) THEN
142
143	sumfrac_wood(:) = sumfrac_wood(:) + veget(:,j)
144
145	ENDIF
146
147	ENDDO
148
149	avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
150
151	avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
152
153	!
154	! 3 Time since last elimination (y)
155	!
156
157	RIP_time = RIP_time + dt / one_year
158
159	!
160	! 4 Agicultural PFTs: present if they are prescribed
161	!
162
163	DO j = 2,nvm
164
165	IF ( .NOT. natural(j) ) THEN
166
167	IF (bavard.GE.4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
168
169	IF ( tree(j) ) THEN
170
171	!
172	! 4.1 don't treat agricultural trees for the moment
173	!
174
175	WRITE(numout,*) 'pftinout: Agricultural trees not treated. We stop.'
176	STOP
177
178	ELSE
179
180	!
181	! 4.2 grasses
182	!
183
184	DO i = 1, npts
185
186	IF ( ( veget_max(i,j) .GT. zero ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
187
188	! prescribed, but not yet there.
189
190	ind(i,j) = veget_max(i,j)
191
192	biomass(i,j,:) = bm_sapl(j,:) * ind(i,j) /veget_max(i,j) ! TL
193	!NV passge 2D
194
195	co2_to_bm(i,j) = co2_to_bm(i,j) +SUM( biomass(i,j,:) ) / dt
196
197	PFTpresent(i,j) = .TRUE.
198
199	everywhere(i,j) = un
200
201	senescence(i,j) = .FALSE.
202
203	age(i,j) = zero
204
205	ENDIF ! prescribed, but PFT not yet present
206
207	ENDDO ! loop over grid points
208
209	ENDIF
210
211	ENDIF ! not natural
212
213	ENDDO ! loop over PFTs
214
215	!
216	! 5 Eliminate PFTs
217	!
218
219	DO j = 2,nvm
220
221	! only for natural PFTs
222
223	IF ( natural(j) ) THEN
224
225	WHERE ( PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
226
227	! PFT there, but not adapted any more (ex: winter too cold): kill
228	! set number of individuals to zero - rest will be done in lpj_kill
229
230	ind(:,j) = zero
231
232	ENDWHERE
233
234	ENDIF ! natural
235
236	ENDDO ! loop over PFTs
237
238	!
239	! 6 Introduce PFTs
240	!
241
242	DO j = 2,nvm
243
244	IF ( natural(j) ) THEN
245
246	! space availability for this PFT
247
248	IF ( tree(j) ) THEN
249	avail(:) = avail_tree(:)
250	ELSE
251	avail(:) = avail_grass(:)
252	ENDIF
253
254	!
255	! 6.1 Check if PFT not present but (adapted and regenerative)
256	!
257
258	can_introduce(:) = .FALSE.
259
260	DO i = 1, npts
261
262	IF ( .NOT. PFTpresent(i,j) .AND. &
263	( adapted(i,j) .GT. adapted_crit ) .AND. &
264	( regenerate(i,j) .GT. regenerate_crit ) ) THEN
265
266	! climate allows introduction
267
268	IF ( need_adjacent(i,j) ) THEN
269
270	! 6.1.1 climate allows introduction, but we need to look at the neighbours
271	! If the PFT has totally invaded at least one adjacent
272	! grid cell, it can be introduced.
273
274	! count number of totally invaded neighbours
275	! no loop so that it can vectorize
276
277	n_present(i) = 0
278
279	IF ( neighbours(i,1) .GT. 0 ) THEN
280	IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
281	n_present(i) = n_present(i)+1
282	ENDIF
283	ENDIF
284	IF ( neighbours(i,3) .GT. 0 ) THEN
285	IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
286	n_present(i) = n_present(i)+1
287	ENDIF
288	ENDIF
289	IF ( neighbours(i,5) .GT. 0 ) THEN
290	IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
291	n_present(i) = n_present(i)+1
292	ENDIF
293	ENDIF
294	IF ( neighbours(i,7) .GT. 0 ) THEN
295	IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
296	n_present(i) = n_present(i)+1
297	ENDIF
298	ENDIF
299
300	IF ( n_present(i) .GT. 0 ) THEN
301
302	! PFT is ubiquitious in at least one adjacent grid box
303	can_introduce(i) = .TRUE.
304
305	ENDIF
306
307	ELSE
308
309	! 6.1.2 we don't have to look at neighbours
310
311	can_introduce(i) = .TRUE.
312
313	ENDIF ! do we have to look at the neighbours?
314
315	ENDIF ! we'd like to introduce the PFT
316
317	ENDDO ! loop over grid points
318
319	!
320	! 6.2 additionally test whether the PFT has been eliminated lately, i.e.
321	! less than 1.25 years ago. Do not take full years as success of
322	! introduction might depend on season.
323
324	WHERE ( RIP_time(:,j) .LT. 1.25 )
325
326	! PFT was eliminated lately - cannot reintroduce
327
328	can_introduce(:) = .FALSE.
329
330	ENDWHERE
331
332	!
333	! 6.3 Introduce that PFT where possible
334	! "can_introduce" means that it either exists in neighbouring grid boxes
335	! or that we do not look at neighbours, that it has not been eliminated
336	! lately, and, of course, that the climate is good for that PFT.
337	!
338
339	WHERE ( can_introduce(:) )
340
341	PFTpresent(:,j) = .TRUE.
342
343	senescence(:,j) = .FALSE.
344
345	! introduce at least a few saplings, even if canopy is closed
346
347	ind(:,j) = ind_0 * (dt/one_year) * avail(:)
348
349	WHERE(veget_max(:,j).GT.0)
350
351	biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j) /veget_max(:,j)
352	biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j) /veget_max(:,j)
353	biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)/veget_max(:,j)
354	biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)/veget_max(:,j)
355	biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)/veget_max(:,j)
356	biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)/veget_max(:,j)
357	biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)/veget_max(:,j)
358	biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)/veget_max(:,j)
359	ELSEWHERE
360
361	biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j)
362	biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j)
363	biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)
364	biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)
365	biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)
366	biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)
367	biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)
368	biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)
369	END WHERE
370	!NV passge 2D
371	co2_to_bm(:,j) = &
372	co2_to_bm(:,j) / dt * &
373	( biomass(:,j,ileaf) + biomass(:,j,isapabove) + &
374	biomass(:,j,isapbelow) + biomass(:,j,iheartabove) + &
375	biomass(:,j,iheartbelow) + biomass(:,j,iroot) + &
376	biomass(:,j,ifruit) + biomass(:,j,icarbres) )
377
378	when_growthinit(:,j) = large_value
379
380	age(:,j) = zero
381
382	! all leaves are young
383	leaf_frac(:,j,1) = un
384
385	! non-zero "long term" npp and last year's leaf mass for saplings -
386	! so they won't be killed off by gap or kill
387
388	npp_longterm(:,j) = 10.
389
390	lm_lastyearmax(:,j) = bm_sapl(j,ileaf) * ind(:,j)
391
392	ENDWHERE ! we can introduce the PFT
393
394	!
395	! 6.4 expansion of the PFT within the grid box (not to be confused with areal
396	! coverage)
397	!
398
399	IF ( treat_expansion ) THEN
400
401	WHERE ( can_introduce(:) )
402	! low value at the beginning
403	everywhere(:,j) = 0.05
404	ENDWHERE
405
406	ELSE
407
408	! expansion is not treated
409
410	WHERE ( can_introduce(:) )
411	everywhere(:,j) = un
412	ENDWHERE
413
414	ENDIF ! treat expansion
415
416	ENDIF ! only natural PFTs
417
418	ENDDO ! loop over PFTs
419
420	!
421	! 7 If a PFT has been present once in a grid box, we suppose that it will survive
422	! in isolated places (e.g., an oasis) within that grid box, even if it gets
423	! officially eliminated from it later. That means that if climate becomes favorable
424	! again, it will not need to get seeds from adjacent grid cells.
425	!
426
427	WHERE ( PFTpresent )
428	need_adjacent = .FALSE.
429	ENDWHERE
430
431	IF (bavard.GE.4) WRITE(numout,*) 'Leaving pftinout'
432
433	END SUBROUTINE pftinout
434
435	END MODULE lpj_pftinout

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

Download in other formats: