Context Navigation

sapiens_agriculture.f90 @ 7346

Last change on this file since 7346 was 5691, checked in by sebastiaan.luyssaert, 6 years ago

DEV: tested with 13, 37 and 64 PFTs with LCC on different pixels. Some configuration run for 20 years on a given pixel, other crash on another pixel. There is a mass balance problem in sapiens_lcc (ticket #482). This commit fixes a problem with PFT1 in littercalc. This PFT is now fully integrated in LCC and subsequent litter and soil dynamics. veget_max was changed in veget_cov_max where appropriate, a typo in enerbil was corrected.

File size: 26.6 KB

Line
1	! ================================================================================================================================
2	! MODULE : sapiens_agriculture
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 Simple approach to harvesting croplands
10	!!
11	!!\n DESCRIPTION: None
12	!!
13	!! RECENT CHANGE(S): None
14	!!
15	!! REFERENCE(S) : None
16	!!
17	!! SVN :
18	!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-DOFOCO/ORCHIDEE/src_stomate/stomate_lpj.f90 $
19	!! $Date: 2013-08-28 16:34:04 +0200 (Wed, 28 Aug 2013) $
20	!! $Revision: 1438 $
21	!! \n
22	!_ ================================================================================================================================
23
24	MODULE sapiens_agriculture
25
26	! modules used:
27	USE stomate_data
28	USE constantes
29	USE pft_parameters
30	USE function_library, ONLY: cc_to_biomass
31
32	IMPLICIT NONE
33
34	! private & public routines
35
36	PRIVATE
37	PUBLIC crop_planting, crop_harvest
38
39	! Variable declaration
40
41	LOGICAL, SAVE :: firstcall = .TRUE. !! first call flag
42	!$OMP THREADPRIVATE(firstcall)
43
44	CONTAINS
45
46
47	!! ================================================================================================================================
48	!! SUBROUTINE : crop_planting
49	!!
50	!>\BRIEF Plant croplands
51	!!
52	!! DESCRIPTION : Plant the crops when the weather is suitable. Uses begin_leaves to decide
53	!! when to plant a crop. To be used within the DOFOCO branch.
54	!!
55	!! RECENT CHANGE(S) :
56	!!
57	!! MAIN OUTPUT VARIABLE(S):
58	!!
59	!! REFERENCE(S) :
60	!!
61	!! FLOWCHART : None
62	!! \n
63	!_ =============================================================================================================================
64
65	SUBROUTINE crop_planting(npts, dt, ipts, ivm, &
66	veget_cov_max, PFTpresent, c0_alloc, when_growthinit, &
67	!!$ time_hum_min, everywhere, plant_status, ind, &
68	time_hum_min, everywhere, plant_status, &
69	circ_class_n, KF, leaf_frac, age, &
70	!!$ npp_longterm, lm_lastyearmax, biomass, circ_class_biomass, &
71	npp_longterm, lm_lastyearmax, circ_class_biomass, &
72	atm_to_bm, k_latosa_adapt)
73
74
75	!! 0. Variable and parameter declaration
76
77	!! 0.1 Input variables
78
79	INTEGER(i_std), INTENT(in) :: npts !! Domain size - number of grid cells (unitless)
80	INTEGER(i_std), INTENT(in) :: ipts !! specific pixel to plant (unitless)
81	INTEGER(i_std), INTENT(in) :: ivm !! specific pft to plant in the specific pixel
82	!! (unitless)
83	REAL(r_std), INTENT(in) :: dt !! time step (dt_days)
84	REAL(r_std), DIMENSION(:,:), INTENT(in) :: veget_cov_max !! "maximal" coverage fraction of a
85	!! PFT (LAI -> infinity) on ground
86	!! (0-1, unitless)
87	REAL(r_std), INTENT(in) :: c0_alloc !! Root to sapwood tradeoff parameter
88
89
90	!! 0.2 Ouput variables
91
92
93	!! 0.3 Modified variables
94
95	LOGICAL, DIMENSION(:,:), INTENT(inout) :: PFTpresent !! PFT exists (true/false)
96	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: plant_status !! Growth and phenological status of the plant
97	!! Different stati are listed in constantes_var
98	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: when_growthinit !! how many days since the
99	!! beginning of the growing season (days)
100	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: time_hum_min !! time elapsed since strongest
101	!! moisture availability (days)
102	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: everywhere !! is the PFT everywhere in the grid box or
103	!! very localized (after its introduction) (?)
104	!!$ REAL(r_std), DIMENSION(:,:), INTENT(inout) :: ind !! Stand level number of individuals
105	!!$ !! @tex $(ind m^{-2})$ @endtex
106	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: circ_class_n !! Number of individuals in each circ class
107	!! @tex $(ind m^{-2})$ @endtex
108	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: KF !! Scaling factor to convert sapwood mass
109	!! into leaf mass (m)
110	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: k_latosa_adapt !! Leaf to sapwood area adapted for long
111	!! term water stress (m)
112	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: leaf_frac !! fraction of leaves in leaf age
113	!! class (0-1, unitless)
114	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: age !! mean age (years)
115	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: npp_longterm !! "long term" net primary productivity
116	!! @tex ($gC m^{-2} year^{-1}$) @endtex
117	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: lm_lastyearmax !! last year's maximum leaf mass for each PFT
118	!! @tex ($gC m^{-2}$) @endtex
119	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: atm_to_bm !! co2 taken up by carbohydrate
120	!! reserve at the beginning of the
121	!! growing season @tex ($gC m^{-2}
122	!! of total ground/day$) @endtex
123	!!$ REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: biomass !! biomass @tex ($gC m^{-2} of
124	!!$ !! ground$) @endtex
125	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass !! Biomass components of the model tree
126	!! within a circumference class
127	!! class @tex $(g C ind^{-1})$ @endtex
128
129	!! 0.4 Local variables
130
131	REAL(r_std), DIMENSION(npts,nvm) :: LF !! Scaling factor to convert sapwood mass
132	!! into root mass (unitless)
133	REAL(r_std), DIMENSION(npts,nvm) :: k_latosa !! Height dependent base value to calculate
134	!! KF (-)
135	REAL(r_std), DIMENSION(npts,nvm) :: histvar !! controls the history output
136	!! level - 0: nothing is written;
137	!! 10: everything is written
138	!! (0-10, unitless)
139	REAL(r_std), DIMENSION(npts,nvm) :: lstress_fac !! Light stress factor, based on total
140	!! transmitted light (unitless, 0-1)
141	REAL(r_std) :: Cs_grass !! Individual plant, sapwood compartment
142	!! @tex $(gC. ind^{-1})$ @endtex
143	REAL(r_std) :: Cl_init !! Initial leaf carbon required to start
144	!! the growing season
145	!! @tex $(gC tree^{-1})$ @endtex
146	REAL(r_std) :: Cr_init !! Initial root carbon required to start
147	!! the growing season
148	!! @tex $(gC tree^{-1})$ @endtex
149	!! relationships (m)
150	INTEGER(i_std) :: iele !! index (unitless)
151	!!$ REAL(r_std) :: ind !! Density of individuals at the stand level
152	!!$ !! @tex $(m^{-2})$ @endtex
153	!!$ REAL(r_std), DIMENSION(nparts,nelements) :: biomass !! Stand level biomass
154	!!$ !! tex $(gC.m^{-2})$ @endtex
155
156	!++++ temp ++++
157	REAL(r_std) :: cn_leaf,cn_root,cn_wood !! C/N ratio of leaves, root and wood pool
158	!! (gC/gN)
159
160	!_ ================================================================================================================================
161
162	IF (printlev>=3) WRITE(numout,*) 'Entering sapiens_crop_planting'
163
164	!! Initialize local printlev
165	!printlev_loc=get_printlev('crop_planting')
166
167	IF ( veget_cov_max(ipts,ivm) .GT. min_stomate .AND. &
168	SUM(circ_class_n(ipts,ivm,:)) .LT. min_stomate) THEN
169
170	!! 1. Prescribe the crops
171
172	! Prescribe the crops - should move to an agricultural routine
173	! Lightstress varies from 0 to 1 and is calculated from the canopy structure (veget)
174	! Given that there is no vegetation at this point, the lightstress cannot be
175	! calculated and is set to 1. However as soon as we grow a canopy it will
176	! experience light stress and so KF should be adjusted. If this is not done, we
177	! can't prescribe tall vegetation which is a useful feature to speed up
178	! optimisation and testing. We will have iterate over light stress and KF to
179	! prescribe vegetation that is in balance with its light environment.
180	lstress_fac(ipts,ivm) = un
181
182	! For crops we assume that an individual crop is 1 m2 of crop. This is set
183	! in nmaxtrees in pft_parameters.f90. It could be set to another value but
184	! with the current code this should not have any meaning. The cropland
185	! does not necessarily covers the whole 1 m2 so adjust for the canopy cover
186	circ_class_n(ipts,ivm,1) = nmaxtrees(ivm) * ha_to_m2 * canopy_cover(ivm)
187
188	! Now we generate the size of a single crop sapling. We do not deal with
189	! circumference classes for crops, but we want to keep the arrays the
190	! same as for the trees so we put the sapling information into the first
191	! circumference class
192
193	! Calculate the sapwood to leaf mass in a similar way as has been done for trees.
194	! For trees this approach had been justified by observations. For crops such
195	! justification is not supported by observations but we didn't try to find it.
196	! Needs more work by someone interested in crops. There might be a more elegant
197	! solution making use of a well observed parameter.
198	k_latosa(ipts,ivm) = (k_latosa_adapt(ipts,ivm) + (lstress_fac(ipts,ivm) * &
199	(k_latosa_max(ivm)-k_latosa_min(ivm))))
200
201	! The mass of the structural carbon relates to the mass of the leaves through
202	! a prescribed parameter ::k_latosa
203	KF(ipts,ivm) = k_latosa(ipts,ivm)
204
205	! Calculate leaf to root area
206	LF(ipts,ivm) = c0_alloc * KF(ipts,ivm)
207
208	!---TEMP---
209	IF(printlev_loc>=4 .AND. test_pft == ivm)THEN
210	WRITE(numout,*) 'KF, ', k_latosa(ipts,ivm), KF(ipts,ivm)
211	WRITE(numout,) 'LF, c0_alloc, ', c0_alloc KF(ipts,ivm), &
212	c0_alloc
213	ENDIF
214	!----------
215
216	! initialize everything to make sure there are not random values floating around
217	! for ncirc = 1
218	circ_class_biomass(ipts,ivm,:,:,:) = zero
219	circ_class_biomass(ipts,ivm,1,:,:) = val_exp
220
221	! Similar as for trees, the initial height of the vegetation can be calculated
222	! from prescribed parameters
223	circ_class_biomass(ipts,ivm,1,ileaf,icarbon) = height_init_min(ivm) / &
224	lai_to_height(ivm) / sla(ivm)
225
226	! Use allometric relationships to define the root mass based on leaf mass. Some
227	! sapwood mass is needed to store the reserves.
228	circ_class_biomass(ipts,ivm,1,iroot,icarbon) = &
229	circ_class_biomass(ipts,ivm,1,ileaf,icarbon) / LF(ipts,ivm)
230	circ_class_biomass(ipts,ivm,1,isapabove,icarbon) = &
231	circ_class_biomass(ipts,ivm,1,ileaf,icarbon) / KF(ipts,ivm)
232
233	! Pools that are defined in the same way for trees and grasses
234	circ_class_biomass(ipts,ivm,1,ilabile,icarbon) = labile_to_total * &
235	( circ_class_biomass(ipts,ivm,1,ileaf,icarbon) + &
236	fcn_root(ivm) * circ_class_biomass(ipts,ivm,1,iroot,icarbon) + &
237	fcn_wood(ivm) * ( circ_class_biomass(ipts,ivm,1,isapabove,icarbon) + &
238	circ_class_biomass(ipts,ivm,1,isapbelow,icarbon) + &
239	circ_class_biomass(ipts,ivm,1,icarbres,icarbon)))
240
241	! Allocate the required N for the phenological growth
242	! Similar as to the carbon this is taken from the atmosphere
243	! That is dealt with later in the code.
244	! Calculate the C/N ratio
245	cn_leaf=cn_leaf_init(ivm)
246	cn_wood=cn_leaf/fcn_wood(ivm)
247	cn_root=cn_leaf/fcn_root(ivm)
248
249	! Use the C/N ratio to calculate the N content for
250	! all the biomass components.
251	circ_class_biomass(ipts,ivm,1,:,initrogen) = &
252	circ_class_biomass(ipts,ivm,1,:,icarbon) / cn_root
253
254	! Overwrite the N content for the leaves and wood
255	! components.
256	circ_class_biomass(ipts,ivm,1,ileaf,initrogen) = &
257	circ_class_biomass(ipts,ivm,1,ileaf,icarbon) / cn_leaf
258	circ_class_biomass(ipts,ivm,1,isapabove,initrogen) = &
259	circ_class_biomass(ipts,ivm,1,isapabove,icarbon) / cn_wood
260
261	! Some of the biomass components that exist for trees are undefined for grasses
262	circ_class_biomass(ipts,ivm,1,isapbelow,:) = zero
263	circ_class_biomass(ipts,ivm,1,iheartabove,:) = zero
264	circ_class_biomass(ipts,ivm,1,iheartbelow,:) = zero
265	circ_class_biomass(ipts,ivm,1,ifruit,:) = zero
266	circ_class_biomass(ipts,ivm,1,icarbres,:) = zero
267
268	! Write initial values
269	IF (printlev_loc>=4) THEN
270	WRITE(numout,*) 'Crop prescribed biomass, carbon ', &
271	circ_class_biomass(ipts,ivm,1,:,icarbon)
272	WRITE(numout,*) 'Crop prescribed biomass, nitrogen ', &
273	circ_class_biomass(ipts,ivm,1,:,initrogen)
274	ENDIF
275
276	!!$ ! Initial biomass (g C m-2)
277	!!$ biomass(ipts,ivm,:,:) = circ_class_biomass(ipts,ivm,1,:,:) * &
278	!!$ ind(ipts,ivm)
279
280	!!$ ! Synchronize biomass and circ_class_biomass (gC tree-1). This
281	!!$ ! allows to more easily check the mass balance closure
282	!!$ circ_class_n(ipts,ivm,1) = ind(ipts,ivm)
283
284	! Set leaf age classes -> all leaves will be current year leaves
285	leaf_frac(ipts,ivm,:) = zero
286	leaf_frac(ipts,ivm,1) = un
287
288	! Set time since last beginning of growing season but only
289	! for the first day of the whole simulation. When the model
290	! is initialized when_growthinit is set to undef. In subsequent
291	! time steps it should have a value.
292	IF (when_growthinit(ipts,ivm) .EQ. undef) THEN
293	when_growthinit(ipts,ivm) = 200
294	time_hum_min(ipts,ivm) = 200
295	ENDIF
296
297	! The biomass to build the saplings is taken from the atmosphere, keep track of
298	! amount to calculate the C-balance closure
299	atm_to_bm(ipts,ivm,:) = atm_to_bm(ipts,ivm,:) + &
300	(SUM(cc_to_biomass(npts, ivm, &
301	circ_class_biomass(ipts,ivm,:,:,:), &
302	circ_class_n(ipts,ivm,:)),1) / dt )
303
304	!!$ DO iele = 1,nelements
305	!!$
306	!!$ atm_to_bm(ipts,ivm,iele) = atm_to_bm(ipts,ivm,iele) + &
307	!!$ ( SUM(biomass(ipts,ivm,:,iele)) / dt )
308	!!$
309	!!$ ENDDO
310
311	!! 2.3 Declare PFT present
312	!! Now that the PFT has biomass it should be declared 'present'
313	!! everywhere in that grid box. Assign some additional properties
314	PFTpresent(ipts,ivm) = .TRUE.
315	everywhere(ipts,ivm) = un
316	age(ipts,ivm) = zero
317	npp_longterm(ipts,ivm) = npp_longterm_init
318	lm_lastyearmax(ipts,ivm) = zero
319
320	!! 4.3 reset when_growthinit counter: start of the growing season
321	when_growthinit(ipts,ivm) = zero
322	plant_status(ipts,ivm) = icanopy
323
324	! PFT is not present, initialize the variables
325	ELSE
326
327	! At the tree level
328	circ_class_n(ipts,ivm,:) = zero
329	circ_class_biomass(ipts,ivm,:,:,:) = zero
330
331	!!$ ! At the stand level
332	!!$ biomass(ipts,ivm,:,:) = zero
333	!!$ ind(ipts,ivm) = zero
334
335	ENDIF ! veget_cov_max gt min_stomate
336
337	IF (printlev_loc>=4) WRITE(numout,*) 'Leaving sapiens_crop_planting'
338
339	END SUBROUTINE crop_planting
340
341
342	!! ================================================================================================================================
343	!! SUBROUTINE : crop_harvest
344	!!
345	!>\BRIEF Harvest of croplands
346	!!
347	!! DESCRIPTION : To take into account biomass harvest from crop (mainly
348	!! to take into account for the reduced litter input and then decreased
349	!! soil carbon. it is a constant (40\%) fraction of turnover. To be used
350	!! within the DOFOCO branch.
351	!!
352	!! RECENT CHANGE(S) : Harvest is stored in harvest_pool for further
353	!! modelling of product use
354	!!
355	!! MAIN OUTPUT VARIABLE(S): ::harvest_pool
356	!!
357	!! REFERENCE(S) :
358	!! - Piao, S., P. Ciais, P. Friedlingstein, N. de Noblet-Ducoudre, P. Cadule,
359	!! N. Viovy, and T. Wang. 2009. Spatiotemporal patterns of terrestrial
360	!! carbon cycle during the 20th century. Global Biogeochemical Cycles
361	!! 23:doi:10.1029/2008GB003339.
362	!!
363	!! FLOWCHART : None
364	!! \n
365	!_ ================================================================================================================================
366
367	SUBROUTINE crop_harvest(npts, ipts, ivm, dt_days, &
368	veget_cov_max, turnover, harvest_pool, harvest_type, &
369	harvest_cut, harvest_area, resolution, circ_class_biomass, &
370	circ_class_n, leaf_meanage)
371
372
373	!! 0. Variable and parameter declaration
374
375	!! 0.1 Input variables
376
377	INTEGER, INTENT(in) :: npts !! Domain size (unitless)
378	INTEGER(i_std), INTENT(in) :: ipts !! specific pixel to plant (unitless)
379	INTEGER(i_std), INTENT(in) :: ivm !! specific pft to plant in the specific pixel
380	!! (unitless)
381	REAL(r_std), INTENT(in) :: dt_days !! Time step (days)
382	REAL(r_std),DIMENSION(npts,2), INTENT(in) :: resolution !! The length in m of each grid-box in X and Y
383	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_cov_max !! Fraction of the pixel covered by a PFT
384	!! @tex $(m^2 m^{-2})$ @endtex
385
386	!! 0.2 Output variables
387
388
389	!! 0.3 Modified variables
390
391	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout) :: circ_class_biomass !! biomass @tex ($gC m^{-2}$) @endtex
392	REAL(r_std), DIMENSION(:,:,:,:),INTENT(inout) :: turnover !! Turnover rates
393	!! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
394	REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout) :: harvest_pool !! The wood and biomass that have been
395	!! havested by humans @tex $(gC)$ @endtex
396	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: harvest_type !! Type of management that resulted
397	!! in the harvest (unitless)
398	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: harvest_cut !! Type of cutting that was used for the harvest
399	!! (unitless)
400	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: harvest_area !! Harvested area (m^{2})
401	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: circ_class_n !! Density of individuals
402	!! @tex $(m^{-2})$ @endtex
403	REAL(r_std), DIMENSION(:,:), INTENT(inout) :: leaf_meanage !! mean age of the leaves (days)
404
405
406	!! 0.4 Local variables
407
408	REAL(r_std) :: pixel_area !! surface area of the pixel @tex ($m^{2}$) @endtex
409
410	!_ ================================================================================================================================
411
412	IF(printlev>=3) WRITE(numout,*) 'Entering sapiens_crop_harvest'
413
414	!! 1.1 Initialize local printlev
415	!printlev_loc=get_printlev('crop_harvest')
416
417	!! 1. Initialize
418	! Reset harvest pool
419	IF(printlev>=4 .AND. ipts == test_grid .AND. ivm == test_pft)THEN
420	WRITE(numout,*) "Entering the crop_harvest routine: ", &
421	harvest_pool(ipts,ivm,:,:)
422	ENDIF
423
424	! We should not reset! Sometimes there is harvest in the harvest
425	! pool, and our mass balance will not be closed if we eliminate it
426	! here. It seems possible that we hit senesence twice in a single
427	! year. This happened on a grid point near the equator.
428	! harvest_pool(ipts,ivm,:,:) = zero
429
430	! Surface area (m2) of the pixel
431	pixel_area = resolution(ipts,1) * resolution(ipts,2)
432
433
434	!! 2. Harvest croplands
435
436	! NOTE that this is a quick fix rather than a final solution. The turnover
437	! of crop biomass has for long be calculated and was assumed to entirely
438	! return to the litter pools. This approach ignored crop harvest. Rather
439	! than harvesting the aboveground biomass (or below ground for some
440	! crops i.e. potatoes, beet, etc which is currently not accounted for) this
441	! routine makes use of the turnover and diverts part of the turnover into
442	! the harvest pool. By doing so it does not end up in the litter.
443
444	! Assume all aboveground biomass is harvested and put it all in the first
445	! diameter class.
446	harvest_pool(ipts,ivm,1,:) = harvest_pool(ipts,ivm,1,:) + &
447	harvest_ratio(ivm) * circ_class_n(ipts,ivm,1) *( circ_class_biomass(ipts,ivm,1,ileaf,:) + &
448	circ_class_biomass(ipts,ivm,1,icarbres,:) + circ_class_biomass(ipts,ivm,1,ilabile,:) + &
449	circ_class_biomass(ipts,ivm,1,ifruit,:) + circ_class_biomass(ipts,ivm,1,isapabove,:)) * &
450	veget_cov_max(ipts,ivm) * pixel_area
451
452	! Associated harvest variables
453	harvest_type(ipts,ivm) = ifm_crop
454	harvest_cut(ipts,ivm) = icut_crop
455	harvest_area(ipts,ivm) = veget_cov_max(ipts,ivm) * pixel_area
456
457	! The belowground becomes litter. All roots remain on site.
458	! Half (::harvest_ratio) of the other biomas pools was harvested.
459	turnover(ipts,ivm,iroot,:) = turnover(ipts,ivm,iroot,:) + &
460	circ_class_biomass(ipts,ivm,1,iroot,:)*circ_class_n(ipts,ivm,1)
461	turnover(ipts,ivm,ileaf,:) = turnover(ipts,ivm,ileaf,:) + &
462	(un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,ileaf,:)*&
463	circ_class_n(ipts,ivm,1)
464	turnover(ipts,ivm,icarbres,:) = turnover(ipts,ivm,icarbres,:) + &
465	(un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,icarbres,:)*&
466	circ_class_n(ipts,ivm,1)
467	turnover(ipts,ivm,ilabile,:) = turnover(ipts,ivm,ilabile,:) + &
468	(un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,ilabile,:)*&
469	circ_class_n(ipts,ivm,1)
470	turnover(ipts,ivm,ifruit,:) = turnover(ipts,ivm,ifruit,:) + &
471	(un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,ifruit,:)*&
472	circ_class_n(ipts,ivm,1)
473	turnover(ipts,ivm,isapabove,:) = turnover(ipts,ivm,isapabove,:) + &
474	(un - harvest_ratio(ivm)) * circ_class_biomass(ipts,ivm,1,isapabove,:)*&
475	circ_class_n(ipts,ivm,1)
476
477
478	! Account for the pools that should not contain biomass for the moment
479	! Do so to make sure the mass balance will be closed
480	turnover(ipts,ivm,isapbelow,:) = turnover(ipts,ivm,isapbelow,:) + &
481	circ_class_biomass(ipts,ivm,1,isapbelow,:)*&
482	circ_class_n(ipts,ivm,1)
483	turnover(ipts,ivm,iheartabove,:) = turnover(ipts,ivm,iheartabove,:) + &
484	circ_class_biomass(ipts,ivm,1,iheartabove,:)*&
485	circ_class_n(ipts,ivm,1)
486	turnover(ipts,ivm,iheartbelow,:) = turnover(ipts,ivm,iheartbelow,:) + &
487	circ_class_biomass(ipts,ivm,1,iheartbelow,:)*&
488	circ_class_n(ipts,ivm,1)
489	! Reset the biomass pools
490	circ_class_biomass(ipts,ivm,:,isapabove,:) = zero
491	circ_class_biomass(ipts,ivm,:,ileaf,:) = zero
492	circ_class_biomass(ipts,ivm,:,iroot,:) = zero
493	circ_class_biomass(ipts,ivm,:,ifruit,:) = zero
494	circ_class_biomass(ipts,ivm,:,icarbres,:) = zero
495	circ_class_biomass(ipts,ivm,:,ilabile,:) = zero
496
497	! These pools should always be empty for crops - just to be sure
498	circ_class_biomass(ipts,ivm,:,iheartbelow,:) = zero
499	circ_class_biomass(ipts,ivm,:,iheartabove,:) = zero
500	circ_class_biomass(ipts,ivm,:,isapbelow,:) = zero
501
502	! No individuals left
503	circ_class_n(ipts,ivm,:) = zero
504
505	! reset leaf age
506	leaf_meanage(ipts,ivm) = zero
507
508	IF(printlev_loc>=4) WRITE(numout,*) 'Leaving sapiens_crop_harvest'
509
510	END SUBROUTINE crop_harvest
511
512	END MODULE sapiens_agriculture

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

Context Navigation

source: branches/publications/ORCHIDEE_CN_CAN_r5698/src_stomate/sapiens_agriculture.f90 @ 7346

Download in other formats: