Context Navigation

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

Last change on this file since 381 was 350, checked in by didier.solyga, 13 years ago
Add labels for the externalized pft parameters. Update obsolete aspects of F77. Replace the last 0.0 by zero in stomate
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(inout) :: 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) = un
210	ENDIF
211	ind(i,j)= delta_veg(j) / cn_ind(i,j)
212	PFTpresent(i,j) = .TRUE.
213	everywhere(i,j) = un
214	senescence(i,j) = .FALSE.
215	age(i,j) = 0.
216
217	when_growthinit(i,j) = large_value
218	leaf_frac(i,j,1) = un
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) = zero
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) = zero
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) = zero
324	!MM=>stomate_lpj.f90 prod100_total(i) = prod100_total(i) + prod100(i,1)
325	prod10(i,0) = zero
326	prod100(i,0) = zero
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: