Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_pftinout.f90 @ 107

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

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

Download in other formats: