Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_lcchange.f90 @ 64

Last change on this file since 64 was 64, checked in by didier.solyga, 13 years ago
Import first version of ORCHIDEE_EXT
File size: 13.5 KB

Line
1	! Stomate: Land cover change
2	!
3	! authors: M. Boisserie, P. Friedlingstein, P. Smith
4	!
5	!
6	!
7	!
8	! version 1.0: May 2008
9	!
10	! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_lcchange.f90,v 1.6 2010/08/05 15:59:08 ssipsl Exp $
11	! IPSL (2006)
12	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
13	!
14	MODULE stomate_lcchange
15
16
17	! modules used:
18
19	USE ioipsl
20	USE stomate_data
21	USE pft_parameters
22	USE constantes
23
24	IMPLICIT NONE
25
26
27	PRIVATE
28	PUBLIC lcchange_main
29
30	CONTAINS
31
32	SUBROUTINE lcchange_main ( npts, dt_days, veget_max, veget_max_new,&
33	biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, veget,&
34	co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, tree, cn_ind,flux10,flux100, &
35	prod10,prod100,&
36	!!$,prod10_total,prod100_total,&
37	convflux,&
38	!!$,cflux_prod_total,
39	cflux_prod10,cflux_prod100, leaf_frac,&
40	npp_longterm, lm_lastyearmax, litter, carbon)
41
42	IMPLICIT NONE
43	! 0 declarations
44
45	! 0.1 input
46
47	! Domain size
48	INTEGER, INTENT(in) :: npts
49
50	! Time step (days)
51	REAL(r_std), INTENT(in) :: dt_days
52
53	! new "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
54	REAL(r_std), DIMENSION(npts,nvm), INTENT(INOUT) :: veget_max_new
55	! biomass of sapling (gC/individu)
56	REAL(r_std) , DIMENSION (nvm, nparts), INTENT(in) :: bm_sapl
57
58	! is pft a tree
59	LOGICAL, DIMENSION(nvm), INTENT(in) :: tree
60
61	! 0.2 modified fields
62
63	! fractional coverage on natural/agricultural ground, taking into
64	! account LAI (=grid-scale fpc)
65	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget
66
67	! "maximal" coverage fraction of a PFT (LAI -> infinity) on nat/agri ground
68	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max
69
70	! biomass (gC/(m**2 of nat/agri ground))
71	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass
72
73	! density of individuals 1/m**2
74	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind
75
76	! mean age (years)
77	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age
78
79	! is the plant senescent? (only for deciduous trees - carbohydrate reserve)
80	! set to .FALSE. if PFT is introduced or killed
81	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence
82
83	! PFT exists
84	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent
85
86	! is the PFT everywhere in the grid box or very localized (after its introduction)
87	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere
88
89	! how many days ago was the beginning of the growing season
90	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit
91
92	! biomass uptaken (gC/(m**2)/day)
93	!NV passage 2D
94
95	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm
96
97	! conversion of biomass to litter (gC/(m**2 of nat/agri ground)) / day
98	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: bm_to_litter
99
100	! crown area (m**2) per ind.
101	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind
102
103	! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
104	! (10 or 100 + 1 : input from year of land cover change)
105	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10
106	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100
107
108	! annual release from the 10/100 year-turnover pool compartments
109	REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10
110	REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100
111
112	! fraction of leaves in leaf age class
113	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
114
115	! last year's maximum leaf mass, for each PFT (gC/(m**2 of nat/agri ground))
116	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax
117
118	! "long term" net primary productivity (gC/(m**2 of nat/agri ground)/year)
119	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm
120
121	! metabolic and structural litter, above and below ground (gC/(m**2 of ground))
122	REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs), INTENT(inout) :: litter
123	! carbon pool: active, slow, or passive,(gC/(m**2 of ground))
124	REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon
125
126	! 0.3 output
127
128	! release during first year following land cover change
129	REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux
130
131	! total annual release from the 10/100 year-turnover pool
132	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10, cflux_prod100
133
134	!!$ ! total products remaining in the pool after the annual release
135	!!$ REAL(r_std), DIMENSION(npts), INTENT(out) :: prod10_total, prod100_total
136	!!$
137	!!$ ! total flux from conflux and the 10/100 year-turnover pool
138	!!$ REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod_total
139
140	! Turnover rates (gC/(m**2 of ground)/day)
141	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: turnover_daily
142
143	! 0.4 local
144
145	! indices
146	INTEGER(i_std) :: i, j, k, l, m
147
148	! biomass increase (gC/(m**2 of ground))
149	REAL(r_std) :: bm_new
150	! biomass loss (gC /(m² of ground))
151	REAL(r_std),DIMENSION(npts,nparts) :: biomass_loss
152	REAL(r_std) :: above
153	! Litter dilution (gC/m²)
154	REAL(r_std),DIMENSION(npts,nlitt,nlevs) :: dilu_lit
155	! Soil Carbondilution (gC/m²)
156	REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon
157
158	! vecteur de conversion
159	REAL(r_std),DIMENSION(nvm) :: delta_veg
160	! vecteur de conversion
161	REAL(r_std) :: delta_veg_sum
162	! change in number of individuals
163	REAL(r_std),DIMENSION(npts,nvm) :: delta_ind
164
165	! =========================================================================
166
167	IF (bavard.GE.3) WRITE(numout,*) 'Entering lcchange_main'
168
169	! yearly initialisation
170	prod10(:,0) = zero
171	prod100(:,0) = zero
172	above = zero
173	convflux(:) = zero
174	cflux_prod10(:) = zero
175	cflux_prod100(:) = zero
176	!!$ prod10_total(:) = zero
177	!!$ prod100_total(:) = zero
178	!!$ cflux_prod_total(:) = zero
179
180	delta_ind(:,:) = zero
181	delta_veg(:) = zero
182
183	DO i = 1, npts
184
185	! Génération du vecteur de conversion
186
187	delta_veg(:) = veget_max_new(i,:)-veget_max(i,:)
188	delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.)
189
190	dilu_lit(i,:,:) = zero
191	dilu_soil_carbon(i,:) = zero
192	biomass_loss(i,:) = zero
193
194	DO j=2, nvm
195	IF ( delta_veg(j) < -min_stomate ) THEN
196	dilu_lit(i,:,:)= dilu_lit(i,:,:) + delta_veg(j)*litter(i,:,j,:) / delta_veg_sum
197	dilu_soil_carbon(i,:)= dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
198	biomass_loss(i,:)=biomass_loss(i,:) + biomass(i,j,:)*delta_veg(j) / delta_veg_sum
199	ENDIF
200	ENDDO
201
202	DO j=2, nvm
203	IF ( delta_veg(j) > min_stomate) THEN
204	! in case of establishment of a new PFT or extension of its coverage in a gridcell
205	IF (veget_max(i,j) .LT. min_stomate) THEN
206	IF (tree(j)) THEN
207	cn_ind(i,j) = cn_sapl(j)
208	ELSE
209	cn_ind(i,j)=1.0
210	ENDIF
211	ind(i,j)= delta_veg(j) / cn_ind(i,j)
212	PFTpresent(i,j) = .TRUE.
213	everywhere(i,j) = 1.
214	senescence(i,j) = .FALSE.
215	age(i,j) = 0.
216
217	when_growthinit(i,j) = large_value
218	leaf_frac(i,j,1) = 1.0
219	npp_longterm(i,j) = 10.
220	lm_lastyearmax(i,j) = bm_sapl(j,ileaf) * ind(i,j)
221	ENDIF
222	IF ( cn_ind(i,j) > min_stomate ) THEN
223	delta_ind(i,j) = delta_veg(j) / cn_ind(i,j)
224	ENDIF
225
226	DO k = 1, nparts
227	!added shilong 060316
228	bm_new = delta_ind(i,j) * bm_sapl(j,k)
229	IF (veget_max(i,j) .GT. min_stomate) THEN
230	IF ((bm_new/delta_veg(j)) > biomass(i,j,k)) THEN
231	bm_new = biomass(i,j,k)*delta_veg(j)
232	ENDIF
233	ENDIF
234	biomass(i,j,k) = ( biomass(i,j,k) * veget_max(i,j) + bm_new ) / veget_max_new(i,j)
235	!NV passage 2D
236	co2_to_bm(i,j) = co2_to_bm(i,j)+ (bm_new* dt_days) / (one_year * veget_max_new(i,j))
237	ENDDO
238
239	! Dilution des reservoirs
240
241	! Litter
242	litter(i,:,j,:)=(litter(i,:,j,:) * veget_max(i,j) + &
243	dilu_lit(i,:,:) * delta_veg(j)) / veget_max_new(i,j)
244
245	! Soil carbon
246	carbon(i,:,j)=(carbon(i,:,j) * veget_max(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max_new(i,j)
247
248	! Litter input
249	bm_to_litter(i,j,isapbelow) = bm_to_litter(i,j,isapbelow) + &
250	& biomass_loss(i,isapbelow)*delta_veg(j) / veget_max_new(i,j)
251	bm_to_litter(i,j,iheartbelow) = bm_to_litter(i,j,iheartbelow) + biomass_loss(i,iheartbelow) *delta_veg(j) &
252	& / veget_max_new(i,j)
253	bm_to_litter(i,j,iroot) = bm_to_litter(i,j,iroot) + biomass_loss(i,iroot)*delta_veg(j) / veget_max_new(i,j)
254	bm_to_litter(i,j,ifruit) = bm_to_litter(i,j,ifruit) + biomass_loss(i,ifruit)*delta_veg(j) / veget_max_new(i,j)
255	bm_to_litter(i,j,icarbres) = bm_to_litter(i,j,icarbres) + &
256	& biomass_loss(i,icarbres) *delta_veg(j) / veget_max_new(i,j)
257	bm_to_litter(i,j,ileaf) = bm_to_litter(i,j,ileaf) + biomass_loss(i,ileaf)*delta_veg(j) / veget_max_new(i,j)
258	age(i,j)=age(i,j)*veget_max(i,j)/veget_max_new(i,j)
259	! End if PFT extension
260	ELSE ! PFT in reduction
261
262	above = biomass(i,j,isapabove) + biomass(i,j,iheartabove)
263	convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) ) ! - car delta_veg <0
264	prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above * delta_veg(j) )
265	prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
266
267	! End Biomass Export
268
269	IF ( veget_max_new(i,j) .LT. min_stomate ) THEN ! Total reduction
270
271	veget_max_new(i,j)= zero
272	ind(i,j) = zero
273	biomass(i,j,:) = zero
274	PFTpresent(i,j) = .FALSE.
275	senescence(i,j) = .FALSE.
276	age(i,j) = zero
277	when_growthinit(i,j) = undef
278	everywhere(i,j) = zero
279	carbon(i,:,j) = zero
280	litter(i,:,j,:) = zero
281	bm_to_litter(i,j,:) = zero
282	turnover_daily(i,j,:) = zero
283
284	ENDIF
285
286	ENDIF ! End if PFT's coverage reduction
287
288	ENDDO ! End loop on PFTs
289
290	! each year, update 10 year-turnover pool content following flux emission
291	! (linear decay (10%) of the initial carbon input)
292	DO l = 0, 8
293	m = 10 - l
294	cflux_prod10(i) = cflux_prod10(i) + flux10(i,m)
295	prod10(i,m) = prod10(i,m-1) - flux10(i,m-1)
296	!MM=>stomate_lpj.f90 prod10_total(i) = prod10_total(i) + prod10(i,m)
297	flux10(i,m) = flux10(i,m-1)
298
299	IF (prod10(i,m) .LT. 1.0) prod10(i,m) = 0.0
300	!MM => quid de prod10_total ???
301	ENDDO
302
303	cflux_prod10(i) = cflux_prod10(i) + flux10(i,1)
304	flux10(i,1) = 0.1 * prod10(i,0)
305	prod10(i,1) = prod10(i,0)
306	!MM => quid du test IF (prod10(i,1) .LT. 1.0) prod10(i,1) = 0.0 ????
307	!MM=>stomate_lpj.f90 prod10_total(i) = prod10_total(i) + prod10(i,1)
308
309	DO l = 0, 98
310	m = 100 - l
311	cflux_prod100(i) = cflux_prod100(i) + flux100(i,m)
312	prod100(i,m) = prod100(i,m-1) - flux100(i,m-1)
313	!MM=>stomate_lpj.f90 prod100_total(i) = prod100_total(i) + prod100(i,m)
314	flux100(i,m) = flux100(i,m-1)
315
316	IF (prod100(i,m).LT.1.0) prod100(i,m) = 0.0
317
318	ENDDO
319
320	cflux_prod100(i) = cflux_prod100(i) + flux100(i,1)
321	flux100(i,1) = 0.01 * prod100(i,0)
322	prod100(i,1) = prod100(i,0)
323	!MM=> IF (prod100(i,1).LT.1.0) prod100(i,1) = 0.0
324	!MM=>stomate_lpj.f90 prod100_total(i) = prod100_total(i) + prod100(i,1)
325	prod10(i,0) = 0.0
326	prod100(i,0) = 0.0
327
328	ENDDO ! End loop on npts
329
330	veget_max(:,:) = veget_max_new(:,:)
331
332	! convert flux from /year into /time step
333	convflux = convflux/one_year*dt_days
334	cflux_prod10 = cflux_prod10/one_year*dt_days
335	cflux_prod100 = cflux_prod100/one_year*dt_days
336	!MM=>stomate_lpj.f90 cflux_prod_total(:) = convflux(:) + cflux_prod10(:) + cflux_prod100(:)
337
338	IF (bavard.GE.4) WRITE(numout,*) 'Leaving lcchange_main'
339
340	END SUBROUTINE lcchange_main
341
342	END MODULE stomate_lcchange

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

Download in other formats: