Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_lcchange.f90 @ 880

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

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

Download in other formats: