Context Navigation

grassland_cutting.f90 @ 6737

Last change on this file since 6737 was 3771, checked in by albert.jornet, 8 years ago
Merge: new Grassland Management Module (GRM) from revision [3759/perso/jinfeng.chang/ORCHIDEE-MICT/ORCHIDEE/ORCHIDEE]. Done by Jinfeng.
File size: 12.0 KB

Line
1	! =================================================================================================================================
2	! MODULE : grassland_cutting
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see
8	! ORCHIDEE/ORCHIDEE_CeCILL.LIC
9	!
10	!>\BRIEF This module execute grassland harvest process, including
11	!! calculate grass biomass after harvest, carbon/nitrogen loss during
12	!! harvest
13	!!
14	!!\n DESCRIPTION : None
15	!!
16	!! RECENT CHANGE(S) : None
17	!!
18	!! REFERENCE(S) : None
19	!!
20	!! \n
21	!_
22	!================================================================================================================================
23
24	! Excution of cutting
25	MODULE grassland_cutting
26
27	! modules used:
28
29	USE grassland_fonctions
30	USE grassland_constantes
31	USE stomate_data
32	USE constantes
33	USE pft_parameters
34	USE ioipsl
35	! USE Balances
36
37	IMPLICIT NONE
38	REAL(r_std), SAVE :: mem_tjulian
39	REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: wshtotsumprev
40
41	CONTAINS
42
43	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
44	!!!!!!!!!!!!!!!! CUTTING
45	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
46
47	! Excute the same process for grids where flag_cutting=1
48	SUBROUTINE cutting_spa(&
49	npts , &
50	tjulian , &
51	flag_cutting , &
52	wshtotcutinit , &
53	lcutinit , &
54	wsh , &
55	wshtot , &
56	wr , &
57	c , &
58	n , &
59	napo , &
60	nsym , &
61	fn , &
62	t , &
63	nel , &
64	biomass , &
65	devstage , &
66	regcount , &
67	wshcutinit , &
68	gmean , &
69	wc_frac , &
70	wnapo , &
71	wnsym , &
72	wgn , &
73	tasum , &
74	tgrowth , &
75	loss , &
76	lossc , &
77	lossn , &
78	tlossstart , &
79	lai , &
80	tcut , &
81	tcut_modif , &
82	wshtotsum , &
83	controle_azote_sum)
84
85	!
86	! 0 declarations
87	!
88
89	! 0.1 input
90
91	INTEGER(i_std) , INTENT(in) :: npts
92	INTEGER(i_std) , INTENT(in) :: tjulian
93	INTEGER(i_std), DIMENSION(npts,nvm) , INTENT(in) :: flag_cutting
94	REAL(r_std), DIMENSION(npts,nvm,ncut) , INTENT(in) :: wshtotcutinit
95	REAL(r_std), DIMENSION(npts,nvm,ncut) , INTENT(in) :: lcutinit
96	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: wsh
97	! total dry mass of shoots
98	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: wshtot
99	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: wr
100	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: c
101	! substrat C concentration(kg C/kg)
102	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: n
103	! substrat N concentration (kg N/kg)
104	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: napo
105	! n concentration of apoplast (kg N m-2)
106	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: nsym
107	! n concentration of symplast (kg N m-2)
108	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fn
109	! structral N concentration kgN/kg
110	INTEGER(i_std) , INTENT(in) :: t
111	! time (d)
112	REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: nel
113	! net lactation energy (mj/kg)
114	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements) , INTENT(inout) :: biomass
115	REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: devstage
116	! stade of developpment of plant (-)
117	INTEGER(i_std), DIMENSION(npts,nvm) , INTENT(inout) :: regcount
118	! number of cut realized(-)
119	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: wshcutinit
120	REAL(r_std), DIMENSION(npts,nvm,ngmean) , INTENT(out) :: gmean
121	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: wc_frac
122	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: wnapo
123	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: wnsym
124	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: wgn
125	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tasum
126	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tgrowth
127	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: loss
128	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: lossc
129	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: lossn
130	REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tlossstart
131	REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: lai
132	! leaf area index of an individual plant
133	REAL(r_std), DIMENSION(npts,nvm,ncut), INTENT(out) :: tcut
134	! date of cutting
135	REAL(r_std), DIMENSION(npts,nvm,ncut), INTENT(out) :: tcut_modif
136	Real(r_std), DIMENSION(npts,nvm) , intent(inout) :: wshtotsum
137	! yield = total (substrate + structural) shoot dry matter (kg DM m-2)
138	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: controle_azote_sum
139
140	! local
141	REAL(r_std), PARAMETER :: yieldloss = 0.05
142	REAL(r_std), DIMENSION(npts,nvm) :: proportion_wsh, proportion_llam
143	INTEGER(i_std) :: h, i, j
144	REAL(r_std), DIMENSION(npts,nvm) :: wlam ! leaf mass (kg m-2)
145	REAL(r_std), DIMENSION(npts,nvm) :: wst ! stem mass (kg m-2)
146	REAL(r_std), DIMENSION(npts,nvm) :: wear ! ear mass (kg m-2)
147	REAL(r_std), DIMENSION(npts,nvm) :: wshtotreg ! yield of regrowth
148	REAL(r_std), DIMENSION(npts,nvm) :: w_postecut
149
150	DO j=2,nvm
151	WHERE(flag_cutting(:,j) .EQ. 1)
152	!transform biomass to dry matter kgDM/m2
153	wlam(:,j) = ( biomass(:,j,ileaf,icarbon)/(1000*CtoDM) ) / &
154	& (1.0 + (mc /12.0)c(:,j) + (mn /14.0)n(:,j) )
155	wst(:,j) = ( biomass(:,j,isapabove,icarbon)/(1000*CtoDM) ) / &
156	& (1.0 + (mc /12.0)c(:,j) + (mn /14.0)n(:,j) )
157	wear(:,j) = ( biomass(:,j,ifruit,icarbon)/(1000*CtoDM) ) / &
158	& (1.0 + (mc /12.0)c(:,j) + (mn /14.0)n(:,j) )
159	END WHERE
160	!070904 AIG definitions
161	!
162	! # wshcutinit: residual structural shoot dry mass
163	! the less, it equals simulated structural shoot dry mass in input file (when it is less
164	! than the value in input file)
165	! in such a case, wshcutinit=wsh=wlam+wstem and proportion_wsh=1
166	! the more, it equals residual structural shoot dry mass
167	! # wshtotcutinit: residual total shoot dry mass (in input file)
168	! in the CALL of the subroutine cutting_spa in module 'plantes', wshtotcutinit_Pl
169	! replaces wshtotcutinit which is an argument of the subroutine cutting_spa
170	! wshtotcutinit_Pl >=0.12
171	! # proportion_wsh: proportion of the residual in comparison with the structural shoot
172	! dry mass simulated
173	! # proportion_llam : proportion of the residual in comparison with the structural leaf
174	! aera simulated
175
176	DO i=1,npts
177	IF (flag_cutting(i,j) .EQ. 1) THEN
178	wshcutinit(i,j) = MIN (wsh(i,j), wshtotcutinit(i,j,regcount(i,j) + 1) / &
179	& (1.0 + (mc/12.0)c(i,j) + (mn/14.0)n(i,j)))
180	END IF
181	END DO
182	WHERE (flag_cutting(:,j) .EQ. 1)
183	WHERE (ABS(wlam(:,j) + wst(:,j)) .GT. 10e-15)
184	proportion_wsh(:,j) = wshcutinit(:,j)/(wlam(:,j) + wst(:,j))
185	ELSEWHERE
186	!JCmodif 070904 AIG
187	! I think there is one error here
188	! If ABS(wlam + wst)< minimum_vital, there is not enough shoot biomass for the cut
189	! to occur, so that proportion_wsh =1 and any dry mass remain the same value(see after)
190	!proportion_wsh(:) = 0.0
191	proportion_wsh(:,j) = 1.0
192	!ENDJCmodif 070904 AIG end
193	END WHERE
194	END WHERE
195
196	! 070725 AIG confirm
197	!-----------------------------
198	! calculation of new biomasses, LAI and substrate concentrations for each component
199	! of different ages after cutting
200	!-----------------------------
201
202	WHERE (flag_cutting(:,j) .EQ. 1)
203
204	wlam(:,j) = proportion_wsh(:,j) * wlam(:,j)
205	wst(:,j) = proportion_wsh(:,j) * wst(:,j)
206	wear(:,j) = 0.0
207	wc_frac(:,j) = c(:,j) * (wr(:,j) + wshcutinit(:,j))
208	wnapo(:,j) = napo(:,j) * (wr(:,j) + wshcutinit(:,j))
209	wnsym(:,j) = nsym(:,j) * (wr(:,j) + wshcutinit(:,j))
210	wgn(:,j) = fn(:,j) * (wr(:,j) + wshcutinit(:,j))
211	! assumed the composition (leaf/stem) in rest of the grass
212	w_postecut(:,j) = wlam(:,j) + wst(:,j)
213	wlam(:,j) = 0.1 * w_postecut(:,j)
214	wst(:,j) = 0.9 * w_postecut(:,j)
215
216	WHERE((devstage(:,j) .LT. devsecond) .AND. (regcount(:,j) .EQ. 1))
217	devstage(:,j) = 0.0
218	ELSEWHERE
219	devstage(:,j) = 2.0
220	END WHERE
221
222	! 070725 AIG confirm
223	!-----------------------------
224	! reinitialization of air sum temperature and counter for regrowth after last cutting
225	!-----------------------------
226
227	! reinitialize accumulated temperature (>5 degree)
228	tasum(:,j) = 0.0
229
230	! time of growthing = 0
231	tgrowth(:,j) = 0.0
232	END WHERE
233
234	! 070725 AIG confirm
235	!-----------------------------
236	! calculations of
237	! - biomass and substrate losses
238	! - total yield(without in or_pa) and LAI
239	! after last cutting
240	!-----------------------------
241
242	DO i=1,npts
243
244	IF (flag_cutting(i,j) .EQ. 1) THEN
245	!ernteverluste, ms 1999
246	!constant yieldloss = 0.05
247	loss(i,j) = MAX (0.0, wshtot(i,j) - wshtotcutinit(i,j,regcount(i,j)+1)) * yieldloss
248	! lossc(i) = (c(i) + fcsh) * (wsh(i) - wshcutinit(i)) * yieldloss
249	lossc(i,j) = loss(i,j)CtoDM!8
250	lossn(i,j) = loss(i,j)* (n(i,j) + fn(i,j))
251	! lossn(i) = (n(i) + fn(i)) * (wsh(i) - wshcutinit(i)) * yieldloss
252	tlossstart(i,j) = t
253
254	! yield of regrowth
255	wshtotreg(i,j) = MAX(0.0 ,wshtot(i,j) - wshtotcutinit(i,j,regcount(i,j)+1)) * (1 - yieldloss)
256	END IF
257	END DO
258
259	! RUN WITH GRASS AUTOGESTION (SATURANT OR NONLIMITANT)
260	! it is important to set it for auto cut
261	IF ((f_autogestion .EQ. 1) .OR. (f_postauto .NE. 0) .OR. &
262	& (f_autogestion .EQ. 3) .OR. (f_autogestion .EQ. 4)) THEN
263	DO i=1,npts
264	IF (flag_cutting(i,j) .EQ. 1) THEN
265	tcut(i,j,regcount(i,j)) = tjulian
266	tcut_modif(i,j,regcount(i,j)) = tjulian
267	END IF
268	END DO
269	END IF
270
271	DO i=1,npts
272	IF (flag_cutting(i,j) .EQ. 1) THEN
273	! annulation gmean
274	gmean(i,j,:) = 0.0
275
276	! increase count number of cut
277	regcount(i,j) = regcount(i,j) + 1
278	END IF
279	END DO
280
281	! 070725 AIG confirm
282	!-----------------------------
283	! calculations of yield, total LAI, total carbon and nitrogen and nel
284	! after regrowth
285	!-----------------------------
286
287	WHERE(flag_cutting(:,j) .EQ. 1)
288	wshtotsum(:,j) = wshtotsum(:,j) + wshtotreg(:,j)
289	biomass(:,j,ileaf,icarbon) = (wlam(:,j) * 1000CtoDM) (1.0 + (mc /12.0)*c(:,j) + &
290	& (mn /14.0)*n(:,j) )
291	biomass(:,j,isapabove,icarbon) = (wst(:,j) * 1000CtoDM) (1.0 + (mc /12.0)*c(:,j) + &
292	& (mn /14.0)*n(:,j) )
293	biomass(:,j,ifruit,icarbon) = (wear(:,j) * 1000CtoDM) (1.0 + (mc /12.0)*c(:,j) + &
294	& (mn /14.0)*n(:,j) )
295
296	END WHERE
297	IF (f_autogestion .LT. 2) THEN
298	controle_azote_sum(:,j)=controle_azote_sum(:,j)+wshtotsum(:,j)-wshtotsumprev(:,j)
299	ENDIF
300
301	wshtotsumprev(:,j)=wshtotsum(:,j)
302	END DO ! nvm
303
304	END SUBROUTINE cutting_spa
305
306	END MODULE grassland_cutting

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

Context Navigation

source: branches/publications/ORCHIDEE_GLUC_r6545/src_stomate/grassland_cutting.f90 @ 6737

Download in other formats: