Context Navigation

stomate_lcchange.f90 @ 8398

Last change on this file since 8398 was 3094, checked in by josefine.ghattas, 8 years ago

Changes related to the update of vegetation fraction due to land use change :

the vegetation file is read in slowproc at the first timestep of a new year (if veget_year=1Y) as before but veget_max is not updated before the end of the first day.
stomate_lcchange is called from stomatelpj in the end of the day if the vegetation file has been read the same day
in the end of sechiba_main, after output has been written, the veget_max is now updated if the file has been read in the begining of the day. The new subroutine slowproc_change_frac has been created for this.
subroutine slowproc_update changed name to slowproc_readvegetmax : this subroutine, as before, only reads and interpolates the new vegetation file. No update is done here.

NViovy, NVuichard, JG
See also ticket #107

Property svn:keywords set to HeadURL Date Author Revision

File size: 18.5 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, carbon)
83
84	IMPLICIT NONE
85
86	!! 0. Variable and parameter declaration
87
88	!! 0.1 Input variables
89
90	INTEGER, INTENT(in) :: npts !! Domain size - number of pixels (unitless)
91	REAL(r_std), INTENT(in) :: dt_days !! Time step of vegetation dynamics for stomate
92	!! (days)
93	REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl !! biomass of sapling
94	!! @tex ($gC individual^{-1}$) @endtex
95	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_old !! Current "maximal" coverage fraction of a PFT (LAI
96	!! -> infinity) on ground
97	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_new !! New "maximal" coverage fraction of a PFT (LAI ->
98	!! infinity) on ground (unitless)
99
100	!! 0.2 Output variables
101
102	REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux !! release during first year following land cover
103	!! change
104	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10 !! total annual release from the 10 year-turnover
105	!! pool @tex ($gC m^{-2}$) @endtex
106	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100 !! total annual release from the 100 year-
107	!! turnover pool @tex ($gC m^{-2}$) @endtex
108	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily !! Turnover rates
109	!! @tex ($gC m^{-2} day^{-1}$) @endtex
110
111	!! 0.3 Modified variables
112
113	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass !! biomass @tex ($gC m^{-2}$) @endtex
114	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind !! Number of individuals @tex ($m^{-2}$) @endtex
115	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age !! mean age (years)
116	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence !! plant senescent (only for deciduous trees) Set
117	!! to .FALSE. if PFT is introduced or killed
118	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent !! Is pft there (unitless)
119	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or very
120	!! localized (unitless)
121	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit !! how many days ago was the beginning of the
122	!! growing season (days)
123	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm !! biomass uptaken
124	!! @tex ($gC m^{-2} day^{-1}$) @endtex
125	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter
126	!! @tex ($gC m^{-2} day^{-1}$) @endtex
127	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind !! crown area of individuals
128	!! @tex ($m^{2}$) @endtex
129	REAL(r_std), DIMENSION(npts,0:10), INTENT(inout) :: prod10 !! products remaining in the 10 year-turnover
130	!! pool after the annual release for each
131	!! compartment (10 + 1 : input from year of land
132	!! cover change)
133	REAL(r_std), DIMENSION(npts,0:100), INTENT(inout) :: prod100 !! products remaining in the 100 year-turnover
134	!! pool after the annual release for each
135	!! compartment (100 + 1 : input from year of land
136	!! cover change)
137	REAL(r_std), DIMENSION(npts,10), INTENT(inout) :: flux10 !! annual release from the 10/100 year-turnover
138	!! pool compartments
139	REAL(r_std), DIMENSION(npts,100), INTENT(inout) :: flux100 !! annual release from the 10/100 year-turnover
140	!! pool compartments
141	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age class
142	!! (unitless)
143	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT
144	!! @tex ($gC m^{-2}$) @endtex
145	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm !! "long term" net primary productivity
146	!! @tex ($gC m^{-2} year^{-1}$) @endtex
147	REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter !! metabolic and structural litter, above and
148	!! below ground @tex ($gC m^{-2}$) @endtex
149	REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon !! carbon pool: active, slow, or passive
150	!! @tex ($gC m^{-2}$) @endtex
151
152	!! 0.4 Local variables
153
154	INTEGER(i_std) :: i, j, k, l, m !! indices (unitless)
155	REAL(r_std),DIMENSION(npts,nelements) :: bm_new !! biomass increase @tex ($gC m^{-2}$) @endtex
156	REAL(r_std),DIMENSION(npts,nparts,nelements) :: biomass_loss !! biomass loss @tex ($gC m^{-2}$) @endtex
157	REAL(r_std) :: above !! aboveground biomass @tex ($gC m^{-2}$) @endtex
158	REAL(r_std),DIMENSION(npts,nlitt,nlevs,nelements) :: dilu_lit !! Litter dilution @tex ($gC m^{-2}$) @endtex
159	REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex
160	REAL(r_std),DIMENSION(nvm) :: delta_veg !! changes in "maximal" coverage fraction of PFT
161	REAL(r_std) :: delta_veg_sum !! sum of delta_veg
162	REAL(r_std),DIMENSION(npts,nvm) :: delta_ind !! change in number of individuals
163	!_ ================================================================================================================================
164
165	IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main'
166
167	!! 1. initialization
168
169	prod10(:,0) = zero
170	prod100(:,0) = zero
171	above = zero
172	convflux(:) = zero
173	cflux_prod10(:) = zero
174	cflux_prod100(:) = zero
175	delta_ind(:,:) = zero
176	delta_veg(:) = zero
177
178	!! 2. calculation of changes in carbon stocks and biomass by land cover change\n
179
180	DO i = 1, npts ! Loop over # pixels - domain size
181
182	!! 2.1 initialization of carbon stocks\n
183	delta_veg(:) = veget_max_new(i,:)-veget_max_old(i,:)
184	delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.)
185
186	dilu_lit(i,:,:,:) = zero
187	dilu_soil_carbon(i,:) = zero
188	biomass_loss(i,:,:) = zero
189
190	!! 2.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n
191	DO j=2, nvm
192	IF ( delta_veg(j) < -min_stomate ) THEN
193	dilu_lit(i,:,:,:) = dilu_lit(i,:,:,:) + delta_veg(j)*litter(i,:,j,:,:) / delta_veg_sum
194	dilu_soil_carbon(i,:) = dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
195	biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum
196	ENDIF
197	ENDDO
198
199	!! 2.3
200	DO j=2, nvm ! Loop over # PFTs
201
202	!! 2.3.1 The case that vegetation coverage of PFTj increases
203	IF ( delta_veg(j) > min_stomate) THEN
204
205	!! 2.3.1.1 Initial setting of new establishment
206	IF (veget_max_old(i,j) .LT. min_stomate) THEN
207	IF (is_tree(j)) THEN
208
209	! cn_sapl(j)=0.5; stomate_data.f90
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) = 1.
217	senescence(i,j) = .FALSE.
218	age(i,j) = zero
219
220	! large_value = 1.E33_r_std
221	when_growthinit(i,j) = large_value
222	leaf_frac(i,j,1) = 1.0
223	npp_longterm(i,j) = npp_longterm_init
224	lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j)
225	ENDIF
226	IF ( cn_ind(i,j) > min_stomate ) THEN
227	delta_ind(i,j) = delta_veg(j) / cn_ind(i,j)
228	ENDIF
229
230	!! 2.3.1.2 Update of biomass in each each carbon stock component
231	!! Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
232	!> heartabove, heartbelow, root, fruit, and carbres)\n
233	DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90
234	DO l = 1,nelements ! loop over # elements
235
236	bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l)
237	IF (veget_max_old(i,j) .GT. min_stomate) THEN
238
239	! in the case that bm_new is overestimated compared with biomass?
240	IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN
241	bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j)
242	ENDIF
243	ENDIF
244	biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_max_old(i,j) + bm_new(i,l) ) / veget_max_new(i,j)
245	co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_max_new(i,j))
246	END DO ! loop over # elements
247	ENDDO ! loop over # carbon stock components
248
249	!! 2.3.1.3 Calculation of dilution in litter, soil carbon, and input of litter
250	!! In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon
251	!! could be shortend?? Are the following formulas correct?
252
253	! Litter
254	litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + &
255	dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max_new(i,j)
256
257	! Soil carbon
258	carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max_new(i,j)
259
260	DO l = 1,nelements
261
262	! Litter input
263	bm_to_litter(i,j,isapbelow,l) = bm_to_litter(i,j,isapbelow,l) + &
264	& biomass_loss(i,isapbelow,l)*delta_veg(j) / veget_max_new(i,j)
265	bm_to_litter(i,j,iheartbelow,l) = bm_to_litter(i,j,iheartbelow,l) + biomass_loss(i,iheartbelow,l) *delta_veg(j) &
266	& / veget_max_new(i,j)
267	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)
268	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)
269	bm_to_litter(i,j,icarbres,l) = bm_to_litter(i,j,icarbres,l) + &
270	& biomass_loss(i,icarbres,l) *delta_veg(j) / veget_max_new(i,j)
271	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)
272
273	END DO
274
275	age(i,j)=age(i,j)*veget_max_old(i,j)/veget_max_new(i,j)
276
277	!! 2.3.2 The case that vegetation coverage of PFTj is no change or decreases
278	ELSE
279
280	!! 2.3.2.1 Biomass export
281	! coeff_lcchange_*: Coeff of biomass export for the year, decade, and century
282	above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon)
283	convflux(i) = convflux(i) - ( coeff_lcchange_1(j) * above * delta_veg(j) )
284	prod10(i,0) = prod10(i,0) - ( coeff_lcchange_10(j) * above * delta_veg(j) )
285	prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
286
287
288	!! 2.3.2.2 Total reduction
289	!! If the vegetation is to small, it has been set to 0.
290	IF ( veget_max_new(i,j) .LT. min_stomate ) THEN
291
292	ind(i,j) = zero
293	biomass(i,j,:,:) = zero
294	PFTpresent(i,j) = .FALSE.
295	senescence(i,j) = .FALSE.
296	age(i,j) = zero
297	when_growthinit(i,j) = undef
298	everywhere(i,j) = zero
299	carbon(i,:,j) = zero
300	litter(i,:,j,:,:) = zero
301	bm_to_litter(i,j,:,:) = zero
302	turnover_daily(i,j,:,:) = zero
303
304	ENDIF
305
306	ENDIF ! End if PFT's coverage reduction
307
308	ENDDO ! Loop over # PFTs
309
310	!! 2.4 update 10 year-turnover pool content following flux emission
311	!! (linear decay (10%) of the initial carbon input)
312	DO l = 0, 8
313	m = 10 - l
314	cflux_prod10(i) = cflux_prod10(i) + flux10(i,m)
315	prod10(i,m) = prod10(i,m-1) - flux10(i,m-1)
316	flux10(i,m) = flux10(i,m-1)
317
318	IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero
319	ENDDO
320
321	cflux_prod10(i) = cflux_prod10(i) + flux10(i,1)
322	flux10(i,1) = 0.1 * prod10(i,0)
323	prod10(i,1) = prod10(i,0)
324
325	!! 2.5 update 100 year-turnover pool content following flux emission\n
326	DO l = 0, 98
327	m = 100 - l
328	cflux_prod100(i) = cflux_prod100(i) + flux100(i,m)
329	prod100(i,m) = prod100(i,m-1) - flux100(i,m-1)
330	flux100(i,m) = flux100(i,m-1)
331
332	IF (prod100(i,m).LT.1.0) prod100(i,m) = zero
333	ENDDO
334
335	cflux_prod100(i) = cflux_prod100(i) + flux100(i,1)
336	flux100(i,1) = 0.01 * prod100(i,0)
337	prod100(i,1) = prod100(i,0)
338	prod10(i,0) = zero
339	prod100(i,0) = zero
340
341	ENDDO ! Loop over # pixels - domain size
342
343	!! 3. history
344	convflux = convflux/one_year*dt_days
345	cflux_prod10 = cflux_prod10/one_year*dt_days
346	cflux_prod100 = cflux_prod100/one_year*dt_days
347
348	IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main'
349
350	END SUBROUTINE lcchange_main
351
352	END MODULE stomate_lcchange

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

Context Navigation

source: branches/publications/ORCHIDEE-ICE_SurfaceMassBalance/src_stomate/stomate_lcchange.f90 @ 8398

Download in other formats: