Context Navigation

source: tags/ORCHIDEE_1_9_5_2/ORCHIDEE/src_stomate/lpj_pftinout.f90 @ 2061

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

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

Download in other formats: