Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

stomate_lcchange.f90 @ 8367

Last change on this file since 8367 was 7245, checked in by nicolas.vuichard, 3 years ago
improve Carbon mass balance closure. See ticket #785
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 37.7 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_lcchange
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.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): Separate subroutines for land cover change and wood use
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, product_init, wood_use_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 lcchange_main is:
56	!! 1. Initialization
57	!! 2. Calculation of changes in carbon stocks and biomass by land cover change
58	!! 4. Writing output
59	!!
60	!! RECENT CHANGE(S) : None
61	!!
62	!! MAIN OUTPUT VARIABLE(S) : ::biomass, ::ind, ::litter, ::som,
63	!! ::co2_to_bm, ::tree_bm_to_litter
64	!!
65	!! REFERENCES : None
66	!!
67	!! FLOWCHART :
68	!! \latexonly
69	!! \includegraphics[scale=0.5]{lcchange.png}
70	!! \endlatexonly
71	!! \n
72	!_ ================================================================================================================================
73
74	SUBROUTINE lcchange_main ( npts, dt_days, veget_cov_max_old, veget_cov_max_new, &
75	biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &
76	co2_to_bm, bm_to_litter, tree_bm_to_litter, turnover_daily, bm_sapl_2D, cn_ind, &
77	flux10,flux100, prod10,prod100, convflux, nflux_prod_total, leaf_frac, &
78	npp_longterm, lm_lastyearmax, litter, som, deepSOM_a, deepSOM_s, deepSOM_p, &
79	soil_n_min, KF, k_latosa_adapt, rue_longterm, lignin_struc, lignin_wood, &
80	convfluxpft, fDeforestToProduct, fLulccResidue, sugar_load)
81
82
83	IMPLICIT NONE
84
85	!! 0. Variable and parameter declaration
86
87	!! 0.1 Input variables
88
89	INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless)
90	REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate
91	!! (days)
92	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: bm_sapl_2D !! biomass of sapling
93	!! @tex ($gC individual^{-1}$) @endtex
94	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_cov_max_old!! Current "maximal" coverage fraction of a PFT (LAI
95	!! -> infinity) on ground
96	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_cov_max_new!! New "maximal" coverage fraction of a PFT (LAI ->
97	!! infinity) on ground (unitless)
98	!! 0.2 Output variables
99
100	REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover
101	!! change
102	REAL(r_std), DIMENSION(npts), INTENT(out) :: nflux_prod_total !! release of N associated to land cover change @tex ($gN m^{-2}$) @endtex
103	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily !! Turnover rates
104	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: convfluxpft !! release during first year following land cover
105	!! change
106	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: fDeforestToProduct !! Deforested biomass into product pool due to anthorpogenic
107	!! land use change
108	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: fLulccResidue !! carbon mass flux into soil and litter due to anthropogenic land use or land cover change
109
110	!! 0.3 Modified variables
111
112	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass !! biomass @tex ($gC m^{-2}$) @endtex
113	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals @tex ($m^{-2}$) @endtex
114	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! mean age (years)
115	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! plant senescent (only for deciduous trees) Set
116	!! to .FALSE. if PFT is introduced or killed
117	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! Is pft there (unitless)
118	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very
119	!! localized (unitless)
120	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the
121	!! growing season (days)
122	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken
123	!! @tex ($gC m^{-2} day^{-1}$) @endtex
124	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter
125	!! @tex ($gC m^{-2} day^{-1}$) @endtex
126	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: tree_bm_to_litter !! conversion of biomass to litter
127	!! @tex ($gC m^{-2} day^{-1}$) @endtex
128	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind !! crown area of individuals
129	!! @tex ($m^{2}$) @endtex
130	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover
131	!! pool after the annual release for each
132	!! compartment (10 + 1 : input from year of land
133	!! cover change)
134	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover
135	!! pool after the annual release for each
136	!! compartment (100 + 1 : input from year of land
137	!! cover change)
138	REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover
139	!! pool compartments
140	REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover
141	!! pool compartments
142	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age class
143	!! (unitless)
144	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT
145	!! @tex ($gC m^{-2}$) @endtex
146	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity
147	!! @tex ($gC m^{-2} year^{-1}$) @endtex
148	REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter !! metabolic and structural litter, above and
149	!! below ground @tex ($gC m^{-2}$) @endtex
150	REAL(r_std),DIMENSION(npts,ncarb,nvm,nelements), INTENT(inout) :: som !! SOM pool: active, slow, or passive
151	!! @tex ($g(C or N) m^{-2}$) @endtex
152	REAL(r_std), DIMENSION(npts,ngrnd,nvm,nelements), INTENT(inout) :: deepSOM_a !! Soil carbon discretized with depth active (g/m**3)
153	REAL(r_std), DIMENSION(npts,ngrnd,nvm,nelements), INTENT(inout) :: deepSOM_s !! Soil carbon discretized with depth slow (g/m**3)
154	REAL(r_std), DIMENSION(npts,ngrnd,nvm,nelements), INTENT(inout) :: deepSOM_p !! Soil carbon discretized with depth passive (g/m**3)
155
156	REAL(r_std),DIMENSION(npts,nvm,nnspec), INTENT(inout) :: soil_n_min !! soil mineral nitrogen pool
157	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout) :: lignin_struc !! ratio Lignine/Carbon in structural litter,
158	!! above and below ground
159	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout) :: lignin_wood !! ratio Lignine/Carbon in woody litter,
160	!! above and below ground
161	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: KF !! Scaling factor to convert sapwood mass
162	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: k_latosa_adapt !! Leaf to sapwood area adapted for long
163	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: rue_longterm !! Longterm radiation use efficiency
164	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sugar_load
165
166	!! 0.4 Local variables
167
168	INTEGER(i_std) :: i, j, k, l, m !! indices (unitless)
169	REAL(r_std),DIMENSION(npts,nelements) :: bm_new !! biomass increase @tex ($gC m^{-2}$) @endtex
170	REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss !! biomass loss @tex ($gC m^{-2}$) @endtex
171	REAL(r_std),DIMENSION(npts,nparts,nelements) :: tree_biomass_loss !! tree biomass loss @tex ($gC m^{-2}$) @endtex
172
173	REAL(r_std) :: above !! aboveground biomass @tex ($gC m^{-2}$) @endtex
174	REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit !! Litter dilution @tex ($gC m^{-2}$) @endtex
175	REAL(r_std),DIMENSION(npts,ncarb,nelements) :: dilu_som !! SOM dilution @tex ($g(C or N) m^{-2}$) @endtex
176	REAL(r_std),DIMENSION(npts,ngrnd,ncarb,nelements) :: dilu_som_vertres !! Vertically-resolved SOM dilution (gC/m**3)
177	REAL(r_std),DIMENSION(npts,nnspec) :: dilu_sin !! Soil Inorganic Nitrogen dilution @tex ($gN m^{-2}$) @endtex
178	!! Soil Inorganic Nitrogen dilution @tex ($gN m^{-2}$) @endtex
179	REAL(r_std),DIMENSION(npts,nlevs) :: dilu_lf_struc !! fraction of structural litter that is lignin
180	!! (0-1,unitless)
181	REAL(r_std),DIMENSION(npts,nlevs) :: dilu_lf_wood !! fraction of woody litter that is lignin
182	!! (0-1,unitless)
183	REAL(r_std),DIMENSION(nvm) :: delta_veg !! changes in "maximal" coverage fraction of PFT
184	REAL(r_std) :: delta_veg_sum !! sum of delta_veg
185	REAL(r_std),DIMENSION(npts,nvm) :: delta_ind !! change in number of individuals
186
187	!_ ================================================================================================================================
188
189	IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main'
190
191	!! 1. initialization
192	prod10(:,0) = zero
193	prod100(:,0) = zero
194	above = zero
195	convflux(:) = zero
196	convfluxpft(:,:) = zero
197	delta_ind(:,:) = zero
198	delta_veg(:) = zero
199	nflux_prod_total(:) = zero
200	fDeforestToProduct(:,:) = zero
201	fLulccResidue(:,:) = zero
202	dilu_som_vertres(:,:,:,:) = zero
203
204	!! 3. calculation of changes in carbon stocks and biomass by land cover change\n
205
206	DO i = 1, npts ! Loop over # pixels - domain size
207
208	!! 3.1 initialization of carbon stocks\n
209	delta_veg(:) = veget_cov_max_new(i,:)-veget_cov_max_old(i,:)
210	delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.)
211
212	dilu_lit(i,:,:,:) = zero
213	dilu_som(i,:,:) = zero
214	biomass_loss(i,:,:) = zero
215	tree_biomass_loss(i,:,:) = zero
216	dilu_sin(i,:) = zero
217	dilu_lf_struc(i,:) = zero
218	dilu_lf_wood(i,:) = zero
219
220	!! 3.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n
221	DO j=1, nvm
222	IF ( delta_veg(j) < -min_stomate ) THEN
223	dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum
224	IF ( ok_soil_carbon_discretization ) THEN
225	DO k=1,nelements
226	dilu_som_vertres(i,:,iactive,k)=dilu_som_vertres(i,:,iactive,k) + &
227	delta_veg(j) * deepSOM_a(i,:,j,k) / delta_veg_sum
228	dilu_som_vertres(i,:,islow,k)=dilu_som_vertres(i,:,islow,k) + &
229	delta_veg(j) * deepSOM_s(i,:,j,k) / delta_veg_sum
230	dilu_som_vertres(i,:,ipassive,k)=dilu_som_vertres(i,:,ipassive,k) + &
231	delta_veg(j) * deepSOM_p(i,:,j,k) / delta_veg_sum
232	ENDDO
233	ELSE
234
235	dilu_som(i,:,:) = dilu_som(i,:,:) + delta_veg(j) * som(i,:,j,:) / delta_veg_sum
236
237	ENDIF
238
239	dilu_sin(i,:)= dilu_sin(i,:) + delta_veg(j) * soil_n_min(i,j,:) / delta_veg_sum
240	dilu_lf_struc(i,:) = dilu_lf_struc(i,:) + &
241	delta_veg(j) * lignin_struc(i,j,:)* litter(i,istructural,j,:,icarbon) / delta_veg_sum
242	dilu_lf_wood(i,:) = dilu_lf_wood(i,:) + &
243	delta_veg(j) * lignin_wood(i,j,:)*litter(i,iwoody,j,:,icarbon) / delta_veg_sum
244	biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum
245	IF(is_tree(j)) THEN
246	tree_biomass_loss(i,:,:) = tree_biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum
247	ENDIF
248	ENDIF
249	ENDDO
250
251	!! 3.3
252	DO j=1, nvm ! Loop over # PFTs
253
254	!! 3.3.1 The case that vegetation coverage of PFTj increases
255	IF ( delta_veg(j) > min_stomate) THEN
256
257	!! 3.3.1.1 Initial setting of new establishment
258	IF (veget_cov_max_old(i,j) .LT. min_stomate) THEN
259	IF (is_tree(j)) THEN
260
261	! cn_sapl(j)=0.5; stomate_data.f90
262	cn_ind(i,j) = cn_sapl(j)
263	ELSE
264	cn_ind(i,j) = un
265	ENDIF
266	ind(i,j)= delta_veg(j) / cn_ind(i,j)
267	PFTpresent(i,j) = .TRUE.
268	everywhere(i,j) = 1.
269	senescence(i,j) = .FALSE.
270	age(i,j) = zero
271
272	! large_value = 1.E33_r_std
273	when_growthinit(i,j) = large_value
274	leaf_frac(i,j,1) = 1.0
275	npp_longterm(i,j) = npp_longterm_init
276	lm_lastyearmax(i,j) = bm_sapl_2D(i,j,ileaf,icarbon) * ind(i,j)
277	ENDIF
278	IF ( cn_ind(i,j) > min_stomate ) THEN
279	delta_ind(i,j) = delta_veg(j) / cn_ind(i,j)
280	ENDIF
281
282	!! 3.3.1.2 Update of biomass in each each carbon stock component
283	!! Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
284	!> heartabove, heartbelow, root, fruit, and carbres)\n
285	DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90
286	DO l = 1,nelements ! loop over # elements
287
288	bm_new(i,l) = delta_ind(i,j) * bm_sapl_2D(i,j,k,l)
289	IF (veget_cov_max_old(i,j) .GT. min_stomate) THEN
290
291	! in the case that bm_new is overestimated compared with biomass?
292	IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN
293	bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j)
294	ENDIF
295	ENDIF
296	biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_cov_max_old(i,j) + bm_new(i,l) ) / veget_cov_max_new(i,j)
297	IF (l==icarbon) THEN
298	co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_cov_max_new(i,j))
299	ENDIF
300	END DO ! loop over # elements
301	ENDDO ! loop over # carbon stock components
302
303	!! 3.3.1.3 Calculation of dilution in litter, soil carbon, and input of litter
304	!! In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon
305	!! could be shortend?? Are the following formulas correct?
306
307
308	! Lignin fraction of structural litter
309	lignin_struc(i,j,:)=(lignin_struc(i,j,:) * veget_cov_max_old(i,j)* litter(i,istructural,j,:,icarbon) + &
310	dilu_lf_struc(i,:) * delta_veg(j)) / veget_cov_max_new(i,j)
311
312	! Lignin fraction of woody litter
313	lignin_wood(i,j,:)=(lignin_wood(i,j,:) * veget_cov_max_old(i,j)* litter(i,iwoody,j,:,icarbon) + &
314	dilu_lf_wood(i,:) * delta_veg(j)) / veget_cov_max_new(i,j)
315
316	! Litter
317	litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_cov_max_old(i,j) + &
318	dilu_lit(i,:,:,:) * delta_veg(j)) / veget_cov_max_new(i,j)
319
320	WHERE ( litter(i,istructural,j,:,icarbon) > min_stomate )
321	lignin_struc(i,j,:) = lignin_struc(i,j,:)/litter(i,istructural,j,:,icarbon)
322	ELSEWHERE
323	lignin_struc(i,j,:) = LC_leaf(j)
324	ENDWHERE
325
326	WHERE ( litter(i,iwoody,j,:,icarbon) > min_stomate )
327	lignin_wood(i,j,:) = lignin_wood(i,j,:)/litter(i,iwoody,j,:,icarbon)
328	ELSEWHERE
329	lignin_wood(i,j,:) = LC_heartabove(j)
330	ENDWHERE
331
332	! Soil Organic Matter
333	IF ( ok_soil_carbon_discretization ) THEN
334	DO k=1,nelements
335	deepSOM_a(i,:,j,k)=(deepSOM_a(i,:,j,k) * veget_cov_max_old(i,j) + &
336	dilu_som_vertres(i,:,iactive,k) * delta_veg(j)) / veget_cov_max_new(i,j)
337	deepSOM_s(i,:,j,k)=(deepSOM_s(i,:,j,k) * veget_cov_max_old(i,j) + &
338	dilu_som_vertres(i,:,islow,k) * delta_veg(j)) / veget_cov_max_new(i,j)
339	deepSOM_p(i,:,j,k)=(deepSOM_p(i,:,j,k) * veget_cov_max_old(i,j) + &
340	dilu_som_vertres(i,:,ipassive,k) * delta_veg(j)) / veget_cov_max_new(i,j)
341	ENDDO
342	ELSE
343	som(i,:,j,:)=(som(i,:,j,:) * veget_cov_max_old(i,j) + dilu_som(i,:,:) * delta_veg(j)) / veget_cov_max_new(i,j)
344	ENDIF
345
346	! Soil inorganic nitrogen
347	soil_n_min(i,j,:)=(soil_n_min(i,j,:) * veget_cov_max_old(i,j) + &
348	dilu_sin(i,:) * delta_veg(j)) / veget_cov_max_new(i,j)
349
350	DO l = 1,nelements
351
352	! Litter input
353	bm_to_litter(i,j,isapbelow,l) = (bm_to_litter(i,j,isapbelow,l) * veget_cov_max_old(i,j) + &
354	biomass_loss(i,isapbelow,l)*delta_veg(j)) / veget_cov_max_new(i,j)
355	bm_to_litter(i,j,iheartbelow,l) = (bm_to_litter(i,j,iheartbelow,l) * veget_cov_max_old(i,j) + &
356	biomass_loss(i,iheartbelow,l) *delta_veg(j)) / veget_cov_max_new(i,j)
357	bm_to_litter(i,j,iroot,l) = (bm_to_litter(i,j,iroot,l) * veget_cov_max_old(i,j) + &
358	biomass_loss(i,iroot,l)*delta_veg(j)) / veget_cov_max_new(i,j)
359	bm_to_litter(i,j,ifruit,l) = (bm_to_litter(i,j,ifruit,l) * veget_cov_max_old(i,j) + &
360	biomass_loss(i,ifruit,l)*delta_veg(j)) / veget_cov_max_new(i,j)
361	bm_to_litter(i,j,icarbres,l) = (bm_to_litter(i,j,icarbres,l) * veget_cov_max_old(i,j) + &
362	biomass_loss(i,icarbres,l) *delta_veg(j)) / veget_cov_max_new(i,j)
363	bm_to_litter(i,j,ilabile,l) = (bm_to_litter(i,j,ilabile,l) * veget_cov_max_old(i,j) + &
364	biomass_loss(i,ilabile,l) *delta_veg(j)) / veget_cov_max_new(i,j)
365	bm_to_litter(i,j,ileaf,l) = (bm_to_litter(i,j,ileaf,l) * veget_cov_max_old(i,j) + &
366	biomass_loss(i,ileaf,l)*delta_veg(j)) / veget_cov_max_new(i,j)
367
368	!*****************
369	tree_bm_to_litter(i,j,isapbelow,l) = (tree_bm_to_litter(i,j,isapbelow,l) * veget_cov_max_old(i,j) + &
370	tree_biomass_loss(i,isapbelow,l) * delta_veg(j)) / veget_cov_max_new(i,j)
371	tree_bm_to_litter(i,j,iheartbelow,l) = (tree_bm_to_litter(i,j,iheartbelow,l) * veget_cov_max_old(i,j) + &
372	tree_biomass_loss(i,iheartbelow,l) * delta_veg(j)) / veget_cov_max_new(i,j)
373	tree_bm_to_litter(i,j,iroot,l) = (tree_bm_to_litter(i,j,iroot,l) * veget_cov_max_old(i,j) + &
374	tree_biomass_loss(i,iroot,l) * delta_veg(j)) / veget_cov_max_new(i,j)
375	tree_bm_to_litter(i,j,ifruit,l) = (tree_bm_to_litter(i,j,ifruit,l) * veget_cov_max_old(i,j) + &
376	tree_biomass_loss(i,ifruit,l) * delta_veg(j)) / veget_cov_max_new(i,j)
377	tree_bm_to_litter(i,j,icarbres,l) = (tree_bm_to_litter(i,j,icarbres,l) * veget_cov_max_old(i,j) + &
378	tree_biomass_loss(i,icarbres,l) * delta_veg(j)) / veget_cov_max_new(i,j)
379	tree_bm_to_litter(i,j,ilabile,l) = (tree_bm_to_litter(i,j,ilabile,l) * veget_cov_max_old(i,j) + &
380	tree_biomass_loss(i,ilabile,l) * delta_veg(j)) / veget_cov_max_new(i,j)
381	tree_bm_to_litter(i,j,ileaf,l) = (tree_bm_to_litter(i,j,ileaf,l) * veget_cov_max_old(i,j) + &
382	tree_biomass_loss(i,ileaf,l) * delta_veg(j)) / veget_cov_max_new(i,j)
383
384
385
386	END DO
387
388	age(i,j)=age(i,j)*veget_cov_max_old(i,j)/veget_cov_max_new(i,j)
389
390	!! 3.3.2 The case that vegetation coverage of PFTj is no change or decreases
391	ELSE
392
393	!! 3.3.2.1 Biomass export
394	! coeff_lcchange_*: Coeff of biomass export for the year, decade, and century
395	above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon)
396	convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) )
397	convfluxpft(i,j)= convfluxpft(i,j) - (coeff_lcchange_1(j) * above * delta_veg(j) )
398	prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above * delta_veg(j) )
399	prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
400
401
402	! Calulate diagnostic variables
403	fDeforestToProduct(i,j) = - above * delta_veg(j)
404	fLulccResidue(i,j) = - ( biomass(i,j,isapbelow,icarbon) &
405	+ biomass(i,j,iheartbelow,icarbon) &
406	+ biomass(i,j,iroot,icarbon) &
407	+ biomass(i,j,ifruit,icarbon) &
408	+ biomass(i,j,icarbres,icarbon) &
409	+ biomass(i,j,ileaf,icarbon) ) * delta_veg(j)
410
411	! Exported nitrogen biomasse asociated with land use change
412	above = biomass(i,j,isapabove,initrogen) + biomass(i,j,iheartabove,initrogen)
413	nflux_prod_total(i) = nflux_prod_total(i) - above* delta_veg(j)
414
415
416	!! If the vegetation is to small, it has been set to 0.
417	IF ( veget_cov_max_new(i,j) .LT. min_stomate ) THEN
418
419	ind(i,j) = zero
420	biomass(i,j,:,:) = zero
421	PFTpresent(i,j) = .FALSE.
422	senescence(i,j) = .FALSE.
423	age(i,j) = zero
424	when_growthinit(i,j) = undef
425	everywhere(i,j) = zero
426	som(i,:,j,:) = zero
427	soil_n_min(i,j,:) = zero
428	litter(i,:,j,:,:) = zero
429	bm_to_litter(i,j,:,:) = zero
430	turnover_daily(i,j,:,:) = zero
431	sugar_load(i,j) = un
432	ENDIF
433
434	ENDIF ! End if PFT's coverage reduction
435
436	ENDDO ! Loop over # PFTs
437
438	ENDDO ! Loop over # pixels - domain size
439
440	!! 4. history
441	convflux = convflux/one_year*dt_days
442	convfluxpft = convfluxpft/one_year*dt_days
443	fDeforestToProduct= fDeforestToProduct/one_year*dt_days
444	fLulccResidue = fLulccResidue/one_year*dt_days
445	nflux_prod_total = nflux_prod_total/one_year*dt_days
446
447	IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main'
448
449	END SUBROUTINE lcchange_main
450
451
452	!! ================================================================================================================================
453	!! SUBROUTINE : wood_use_main
454	!!
455	!>\BRIEF Carbon dynamics of the 10 year and 100 year wood use pool
456	!!
457	!! DESCRIPTION : This subroutine is always activate even if the VEGET_UPDATE=0Y.
458	!! Hence, wood decomposition is calculated even if land cover change is not used.
459	!! This guarantees that wood decomposition is correctly accounted for in an experiment
460	!! where land cover change is first used and then stopped to use. One example could be
461	!! that land cover change is used in the transient spin-up and then stopped to be used
462	!! in one of the factorial experiments.\n
463	!!
464	!! Decomposition of the product pool is linear in the sens that each year either 1/10
465	!! or 1/100 of the carbon and nitrogen pools is being decomposed. This differes from
466	!! the typical decomposition functions which are assumed to be exponential but which
467	!! are described a Q10 rather than a longivety.
468	!!
469	!! Wood product pools are filled in lcchange_main when land cover change occurs and the
470	!! decomposition of the annual pool (which only occurs when there is a land cover change)
471	!! is also calculated in lcchange_main. This routine only updates the 10 year and 100
472	!! year wood pools.
473	!!
474	!! Main structure of wood_use_main is:
475	!! 1. Initialize
476	!! 2. Update 10-year and 100-year turnover pool contents
477	!! 3. Write output files
478	!!
479	!! RECENT CHANGE(S) : None
480	!!
481	!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100,
482	!! :: cflux_prod10 and :: cflux_prod100
483	!!
484	!! REFERENCES : None
485	!!
486	!! FLOWCHART :
487	!! \latexonly
488	!! \includegraphics[scale=0.5]{lcchange.png}
489	!! \endlatexonly
490	!! \n
491	!_ ================================================================================================================================
492
493	SUBROUTINE wood_use_main (npts, dt_days, cflux_prod10, cflux_prod100, flux10, flux100, &
494	prod10, prod100)
495
496	!! 0. Variable and parameter declaration
497
498	!! 0.1 Input variables
499	INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless)
500	REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate
501	!! (days)
502
503	!! 0.2 Output variables
504	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10 !! total annual release from the 10 year-turnover
505	!! pool @tex ($gC m^{-2}$) @endtex
506	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100 !! total annual release from the 100 year-
507	!! turnover pool @tex ($gC m^{-2}$) @endtex
508
509	!! 0.3 Modified variables
510	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover
511	!! pool after the annual release for each
512	!! compartment (10 + 1 : input from year of land
513	!! cover change)
514	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover
515	!! pool after the annual release for each
516	!! compartment (100 + 1 : input from year of land
517	!! cover change)
518	REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover
519	!! pool compartments
520	REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover
521	!! pool compartments
522
523	!! 0.4 Local variables
524	INTEGER(i_std) :: i, l, m !! indices (unitless)
525
526	!_ ================================================================================================================================
527
528	IF (printlev>=3) WRITE(numout,*) 'Entering wood_use_main'
529
530	!! 1. Initialization
531	cflux_prod10(:) = zero
532	cflux_prod100(:) = zero
533
534	!! 2. Decompose the wood product pool
535	! The annual flux is accounted for in lcchange_main and only occurs the
536	! year of a land cover change. The 10 year and 100 year pools need to be
537	! updated even if land cover change is no longer accounted for and are
538	! there subject to their own subroutine.
539	DO i = 1,npts
540
541	!! Update 10 year-turnover pool content following flux emission
542	!! (linear decay (10%) of the initial carbon input)
543	DO l = 0, 8
544	m = 10 - l
545	cflux_prod10(i) = cflux_prod10(i) + flux10(i,m)
546	prod10(i,m) = prod10(i,m-1) - flux10(i,m-1)
547	flux10(i,m) = flux10(i,m-1)
548
549	!+++CHECK+++
550	! This variable always has the same dimensions and the
551	! code always loops over all dimensions irrespective whether
552	! they have a non-zero value or not. The line below is
553	! NOT conserving mass.
554	IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero
555	!+++++++++++
556	ENDDO
557
558	cflux_prod10(i) = cflux_prod10(i) + flux10(i,1)
559	flux10(i,1) = 0.1 * prod10(i,0)
560	prod10(i,1) = prod10(i,0)
561
562	!! Update 100 year-turnover pool content following flux emission\n
563	DO l = 0, 98
564	m = 100 - l
565	cflux_prod100(i) = cflux_prod100(i) + flux100(i,m)
566	prod100(i,m) = prod100(i,m-1) - flux100(i,m-1)
567	flux100(i,m) = flux100(i,m-1)
568
569	!+++CHECK+++
570	! This variable always has the same dimensions and the
571	! code always loops over all dimensions irrespective whether
572	! they have a non-zero value or not. The line below is
573	! NOT conserving mass.
574	IF (prod100(i,m).LT.1.0) prod100(i,m) = zero
575	!+++++++++++
576	ENDDO
577
578	cflux_prod100(i) = cflux_prod100(i) + flux100(i,1)
579	flux100(i,1) = 0.01 * prod100(i,0)
580	prod100(i,1) = prod100(i,0)
581	prod10(i,0) = zero
582	prod100(i,0) = zero
583
584
585	ENDDO ! Loop over # pixels - domain size
586
587	!! 4. history
588	cflux_prod10 = cflux_prod10/one_year*dt_days
589	cflux_prod100 = cflux_prod100/one_year*dt_days
590
591	IF (printlev>=4) WRITE(numout,*) 'Leaving wood_use_main'
592
593	END SUBROUTINE wood_use_main
594
595	!! ================================================================================================================================
596	!! SUBROUTINE : product_init
597	!!
598	!>\BRIEF Initialize 10 year and 100 year wood use pool in years without lcchange
599	!!
600	!! DESCRIPTION : This subroutine is only used when VEGET_UPDATE=0Y. In those years
601	!! prod10 and prod100 are initialized such that the wood_use can be accounted for.
602	!!
603	!! RECENT CHANGE(S) : None
604	!!
605	!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100
606	!!
607	!! REFERENCES : None
608	!!
609	!! FLOWCHART :
610	!! \latexonly
611	!! \includegraphics[scale=0.5]{lcchange.png}
612	!! \endlatexonly
613	!! \n
614	!_ ================================================================================================================================
615
616	SUBROUTINE product_init (npts, prod10, prod100, flux10, flux100, convflux, &
617	nflux_prod_total, convfluxpft, fDeforestToProduct, fLulccResidue)
618
619
620	!! 0. Variable and parameter declaration
621
622	!! 0.1 Input variables
623	INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless)
624
625
626	!! 0.2 Output variables
627	REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover
628	!! change
629	REAL(r_std), DIMENSION(npts), INTENT(out) :: nflux_prod_total !! release of N associated to land cover change @tex ($gN m^{-2}$) @endtex
630	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: convfluxpft !! release during first year following land cover
631	!! change
632	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: fDeforestToProduct !! Deforested biomass into product pool due to anthorpogenic
633	!! land use change
634	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: fLulccResidue !! carbon mass flux into soil and litter due to anthropogenic land use or land cover change
635
636	!! 0.3 Modified variables
637	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover
638	!! pool after the annual release for each
639	!! compartment (10 + 1 : input from year of land
640	!! cover change)
641	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover
642	!! pool after the annual release for each
643	!! compartment (100 + 1 : input from year of land
644	!! cover change)
645	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover
646	!! pool compartments
647	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover
648	!! pool compartments
649
650	!! 0.4 Local variables
651
652	!_ ================================================================================================================================
653
654	IF (printlev>=3) WRITE(numout,*) 'Entering product_init'
655
656	prod10(:,0) = zero
657	prod100(:,0) = zero
658	flux10(:,0) = zero
659	flux100(:,0) = zero
660	convflux(:) = zero
661	nflux_prod_total(:) = zero
662	convfluxpft(:,:) = zero
663	fDeforestToProduct(:,:) = zero
664	fLulccResidue(:,:) = zero
665
666	IF (printlev>=4) WRITE(numout,*) 'Leaving product_init'
667
668	END SUBROUTINE product_init
669
670	END MODULE stomate_lcchange

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

Context Navigation

source: branches/ORCHIDEE_3_CMIP6/ORCHIDEE/src_stomate/stomate_lcchange.f90 @ 8367

Download in other formats: