Context Navigation

source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_lcchange.f90 @ 5816

Last change on this file since 5816 was 5816, checked in by jinfeng.chang, 5 years ago
copy ORCHIDEE-GMv3.2 for publication
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 19.3 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_lcchange
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF Impact of land cover change on carbon stocks
10	!!
11	!!\n DESCRIPTION: None
12	!!
13	!! RECENT CHANGE(S): None
14	!!
15	!! REFERENCE(S) : None
16	!!
17	!! SVN :
18	!! $HeadURL$
19	!! $Date$
20	!! $Revision$
21	!! \n
22	!_ ================================================================================================================================
23
24
25	MODULE stomate_lcchange
26
27	! modules used:
28
29	USE ioipsl_para
30	USE stomate_data
31	USE pft_parameters
32	USE constantes
33
34	IMPLICIT NONE
35
36	PRIVATE
37	PUBLIC lcchange_main
38
39	CONTAINS
40
41
42	!! ================================================================================================================================
43	!! SUBROUTINE : lcchange_main
44	!!
45	!>\BRIEF Impact of land cover change on carbon stocks
46	!!
47	!! DESCRIPTION : This subroutine is always activate if VEGET_UPDATE>0Y in the configuration file, which means that the
48	!! vegetation map is updated regulary. lcchange_main is called from stomateLpj the first time step after the vegetation
49	!! map has been changed.
50	!! The impact of land cover change on carbon stocks is computed in this subroutine. The land cover change is written
51	!! by the difference of current and previous "maximal" coverage fraction of a PFT.
52	!! On the basis of this difference, the amount of 'new establishment'/'biomass export',
53	!! and increase/decrease of each component, are estimated.\n
54	!!
55	!! Main structure of lpj_establish.f90 is:
56	!! 1. Initialization
57	!! 2. Calculation of changes in carbon stocks and biomass by land cover change
58	!! 3. Update 10 year- and 100 year-turnover pool contents
59	!! 4. History
60	!!
61	!! RECENT CHANGE(S) : None
62	!!
63	!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100,
64	!! :: cflux_prod10 and :: cflux_prod100
65	!!
66	!! REFERENCES : None
67	!!
68	!! FLOWCHART :
69	!! \latexonly
70	!! \includegraphics[scale=0.5]{lcchange.png}
71	!! \endlatexonly
72	!! \n
73	!_ ================================================================================================================================
74
75
76	SUBROUTINE lcchange_main ( npts, dt_days, veget_max_old, veget_max_new, &
77	biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &
78	co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
79	prod10,prod100,&
80	convflux,&
81	cflux_prod10,cflux_prod100, leaf_frac,&
82	npp_longterm, lm_lastyearmax, litter, &
83	!gmjc
84	litter_avail, litter_not_avail, &
85	!end gmjc
86	carbon)
87
88	IMPLICIT NONE
89
90	!! 0. Variable and parameter declaration
91
92	!! 0.1 Input variables
93
94	INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless)
95	REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate
96	!! (days)
97	REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl !! biomass of sapling
98	!! @tex ($gC individual^{-1}$) @endtex
99	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_old !! Current "maximal" coverage fraction of a PFT (LAI
100	!! -> infinity) on ground
101	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_new !! New "maximal" coverage fraction of a PFT (LAI ->
102	!! infinity) on ground (unitless)
103
104	!! 0.2 Output variables
105
106	REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover
107	!! change
108	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10 !! total annual release from the 10 year-turnover
109	!! pool @tex ($gC m^{-2}$) @endtex
110	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100 !! total annual release from the 100 year-
111	!! turnover pool @tex ($gC m^{-2}$) @endtex
112	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily !! Turnover rates
113	!! @tex ($gC m^{-2} day^{-1}$) @endtex
114
115	!! 0.3 Modified variables
116
117	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass !! biomass @tex ($gC m^{-2}$) @endtex
118	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals @tex ($m^{-2}$) @endtex
119	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! mean age (years)
120	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! plant senescent (only for deciduous trees) Set
121	!! to .FALSE. if PFT is introduced or killed
122	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! Is pft there (unitless)
123	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very
124	!! localized (unitless)
125	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the
126	!! growing season (days)
127	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken
128	!! @tex ($gC m^{-2} day^{-1}$) @endtex
129	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter
130	!! @tex ($gC m^{-2} day^{-1}$) @endtex
131	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind !! crown area of individuals
132	!! @tex ($m^{2}$) @endtex
133	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover
134	!! pool after the annual release for each
135	!! compartment (10 + 1 : input from year of land
136	!! cover change)
137	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover
138	!! pool after the annual release for each
139	!! compartment (100 + 1 : input from year of land
140	!! cover change)
141	REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover
142	!! pool compartments
143	REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover
144	!! pool compartments
145	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age class
146	!! (unitless)
147	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT
148	!! @tex ($gC m^{-2}$) @endtex
149	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity
150	!! @tex ($gC m^{-2} year^{-1}$) @endtex
151	REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter !! metabolic and structural litter, above and
152	!! below ground @tex ($gC m^{-2}$) @endtex
153	REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon !! carbon pool: active, slow, or passive
154	!! @tex ($gC m^{-2}$) @endtex
155	!gmjc
156	REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail
157	REAL(r_std), DIMENSION(npts,nlitt,nvm) , INTENT(inout):: litter_not_avail
158	!end gmjc
159	!! 0.4 Local variables
160
161	INTEGER(i_std) :: i, j, k, l, m !! indices (unitless)
162	REAL(r_std),DIMENSION(npts,nelements) :: bm_new !! biomass increase @tex ($gC m^{-2}$) @endtex
163	REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss !! biomass loss @tex ($gC m^{-2}$) @endtex
164	REAL(r_std) :: above !! aboveground biomass @tex ($gC m^{-2}$) @endtex
165	REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit !! Litter dilution @tex ($gC m^{-2}$) @endtex
166	REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex
167	REAL(r_std),DIMENSION(nvm) :: delta_veg !! changes in "maximal" coverage fraction of PFT
168	REAL(r_std) :: delta_veg_sum !! sum of delta_veg
169	REAL(r_std),DIMENSION(npts,nvm) :: delta_ind !! change in number of individuals
170	!_ ================================================================================================================================
171
172	IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main'
173
174	!! 1. initialization
175
176	prod10(:,0) = zero
177	prod100(:,0) = zero
178	above = zero
179	convflux(:) = zero
180	cflux_prod10(:) = zero
181	cflux_prod100(:) = zero
182	delta_ind(:,:) = zero
183	delta_veg(:) = zero
184
185	!! 2. calculation of changes in carbon stocks and biomass by land cover change\n
186
187	DO i = 1, npts ! Loop over # pixels - domain size
188
189	!! 2.1 initialization of carbon stocks\n
190	delta_veg(:) = veget_max_new(i,:)-veget_max_old(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	!! 2.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n
198	DO j=2, nvm
199	IF ( delta_veg(j) < -min_stomate ) THEN
200	dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum
201	dilu_soil_carbon(i,:) = dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
202	biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum
203	ENDIF
204	ENDDO
205
206	!! 2.3
207	DO j=2, nvm ! Loop over # PFTs
208
209	!! 2.3.1 The case that vegetation coverage of PFTj increases
210	IF ( delta_veg(j) > min_stomate) THEN
211
212	!! 2.3.1.1 Initial setting of new establishment
213	IF (veget_max_old(i,j) .LT. min_stomate) THEN
214	IF (is_tree(j)) THEN
215
216	! cn_sapl(j)=0.5; stomate_data.f90
217	cn_ind(i,j) = cn_sapl(j)
218	ELSE
219	cn_ind(i,j) = un
220	ENDIF
221	ind(i,j)= delta_veg(j) / cn_ind(i,j)
222	PFTpresent(i,j) = .TRUE.
223	everywhere(i,j) = 1.
224	senescence(i,j) = .FALSE.
225	age(i,j) = zero
226
227	! large_value = 1.E33_r_std
228	when_growthinit(i,j) = large_value
229	leaf_frac(i,j,1) = 1.0
230	npp_longterm(i,j) = npp_longterm_init
231	lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j)
232	ENDIF
233	IF ( cn_ind(i,j) > min_stomate ) THEN
234	delta_ind(i,j) = delta_veg(j) / cn_ind(i,j)
235	ENDIF
236
237	!! 2.3.1.2 Update of biomass in each each carbon stock component
238	!! Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
239	!> heartabove, heartbelow, root, fruit, and carbres)\n
240	DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90
241	DO l = 1,nelements ! loop over # elements
242
243	bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l)
244	IF (veget_max_old(i,j) .GT. min_stomate) THEN
245
246	! in the case that bm_new is overestimated compared with biomass?
247	IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN
248	bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j)
249	ENDIF
250	ENDIF
251	biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_max_old(i,j) + bm_new(i,l) ) / veget_max_new(i,j)
252	co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_max_new(i,j))
253	END DO ! loop over # elements
254	ENDDO ! loop over # carbon stock components
255
256	!! 2.3.1.3 Calculation of dilution in litter, soil carbon, and input of litter
257	!! In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon
258	!! could be shortend?? Are the following formulas correct?
259
260	! Litter
261	litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + &
262	dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max_new(i,j)
263	!gmjc
264	! available and not available litter for grazing
265	! case vegetation j increase
266	! only not available litter increase/decrease, available litter
267	! will not change, due to tree litter can not be eaten
268	IF (is_grassland_manag(j) .AND. is_grassland_grazed(j)) THEN
269	litter_avail(i,:,j) = litter_avail(i,:,j) * veget_max_old(i,j)/veget_max_new(i,j)
270	litter_not_avail(i,:,j) = litter(i,:,j,iabove,icarbon) -litter_avail(i,:,j)
271	ENDIF
272	!end gmjc
273
274	! Soil carbon
275	carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max_new(i,j)
276
277	DO l = 1,nelements
278
279	! Litter input
280	bm_to_litter(i,j,isapbelow,l) = bm_to_litter(i,j,isapbelow,l) + &
281	& biomass_loss(i,isapbelow,l)*delta_veg(j) / veget_max_new(i,j)
282	bm_to_litter(i,j,iheartbelow,l) = bm_to_litter(i,j,iheartbelow,l) + biomass_loss(i,iheartbelow,l) *delta_veg(j) &
283	& / veget_max_new(i,j)
284	bm_to_litter(i,j,iroot,l) = bm_to_litter(i,j,iroot,l) + biomass_loss(i,iroot,l)*delta_veg(j) / veget_max_new(i,j)
285	bm_to_litter(i,j,ifruit,l) = bm_to_litter(i,j,ifruit,l) + biomass_loss(i,ifruit,l)*delta_veg(j) / veget_max_new(i,j)
286	bm_to_litter(i,j,icarbres,l) = bm_to_litter(i,j,icarbres,l) + &
287	& biomass_loss(i,icarbres,l) *delta_veg(j) / veget_max_new(i,j)
288	bm_to_litter(i,j,ileaf,l) = bm_to_litter(i,j,ileaf,l) + biomass_loss(i,ileaf,l)*delta_veg(j) / veget_max_new(i,j)
289
290	END DO
291
292	age(i,j)=age(i,j)*veget_max_old(i,j)/veget_max_new(i,j)
293
294	!! 2.3.2 The case that vegetation coverage of PFTj is no change or decreases
295	ELSE
296
297	!! 2.3.2.1 Biomass export
298	! coeff_lcchange_*: Coeff of biomass export for the year, decade, and century
299	above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon)
300	convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) )
301	prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above * delta_veg(j) )
302	prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
303
304
305	!! 2.3.2.2 Total reduction
306	!! If the vegetation is to small, it has been set to 0.
307	IF ( veget_max_new(i,j) .LT. min_stomate ) THEN
308
309	ind(i,j) = zero
310	biomass(i,j,:,:) = zero
311	PFTpresent(i,j) = .FALSE.
312	senescence(i,j) = .FALSE.
313	age(i,j) = zero
314	when_growthinit(i,j) = undef
315	everywhere(i,j) = zero
316	carbon(i,:,j) = zero
317	litter(i,:,j,:,:) = zero
318	bm_to_litter(i,j,:,:) = zero
319	turnover_daily(i,j,:,:) = zero
320
321	ENDIF
322
323	ENDIF ! End if PFT's coverage reduction
324
325	ENDDO ! Loop over # PFTs
326
327	!! 2.4 update 10 year-turnover pool content following flux emission
328	!! (linear decay (10%) of the initial carbon input)
329	DO l = 0, 8
330	m = 10 - l
331	cflux_prod10(i) = cflux_prod10(i) + flux10(i,m)
332	prod10(i,m) = prod10(i,m-1) - flux10(i,m-1)
333	flux10(i,m) = flux10(i,m-1)
334
335	IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero
336	ENDDO
337
338	cflux_prod10(i) = cflux_prod10(i) + flux10(i,1)
339	flux10(i,1) = 0.1 * prod10(i,0)
340	prod10(i,1) = prod10(i,0)
341
342	!! 2.5 update 100 year-turnover pool content following flux emission\n
343	DO l = 0, 98
344	m = 100 - l
345	cflux_prod100(i) = cflux_prod100(i) + flux100(i,m)
346	prod100(i,m) = prod100(i,m-1) - flux100(i,m-1)
347	flux100(i,m) = flux100(i,m-1)
348
349	IF (prod100(i,m).LT.1.0) prod100(i,m) = zero
350	ENDDO
351
352	cflux_prod100(i) = cflux_prod100(i) + flux100(i,1)
353	flux100(i,1) = 0.01 * prod100(i,0)
354	prod100(i,1) = prod100(i,0)
355	prod10(i,0) = zero
356	prod100(i,0) = zero
357
358	ENDDO ! Loop over # pixels - domain size
359
360	!! 3. history
361	convflux = convflux/one_year*dt_days
362	cflux_prod10 = cflux_prod10/one_year*dt_days
363	cflux_prod100 = cflux_prod100/one_year*dt_days
364
365	IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main'
366
367	END SUBROUTINE lcchange_main
368
369	END MODULE stomate_lcchange

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

Download in other formats: