Context Navigation

stomate_lpj.f90 @ 3850

Last change on this file since 3850 was 943, checked in by didier.solyga, 12 years ago
Bug fix : forget to inverse endif and enddo in my last commit.
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 48.9 KB

Line
1	! Stomate: phenology, allocation, etc.
2	!
3	! authors: A. Botta, P. Friedlingstein, C. Morphopoulos, N. Viovy, et al.
4	!
5	! bits and pieces put together by G. Krinner
6	!
7	! version 0.0: August 1998
8	!
9	!< $HeadURL$
10	!< $Date$
11	!< $Author$
12	!< $Revision$
13	! IPSL (2006)
14	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
15	!
16	MODULE stomate_lpj
17
18	! modules used:
19
20	USE ioipsl
21	USE grid
22	USE stomate_data
23	USE constantes
24	USE pft_parameters
25	USE lpj_constraints
26	USE lpj_pftinout
27	USE lpj_kill
28	USE lpj_crown
29	USE lpj_fire
30	USE lpj_gap
31	USE lpj_light
32	USE lpj_establish
33	USE lpj_cover
34	USE stomate_prescribe
35	USE stomate_phenology
36	USE stomate_alloc
37	USE stomate_npp
38	USE stomate_turnover
39	USE stomate_litter
40	USE stomate_soilcarbon
41	USE stomate_vmax
42	USE stomate_assimtemp
43	USE stomate_lcchange
44	! USE Write_Field_p
45
46	IMPLICIT NONE
47
48	! private & public routines
49
50	PRIVATE
51	PUBLIC StomateLpj,StomateLpj_clear
52
53	! first call
54	LOGICAL, SAVE :: firstcall = .TRUE.
55
56	CONTAINS
57
58	SUBROUTINE StomateLpj_clear
59
60	CALL prescribe_clear
61	CALL phenology_clear
62	CALL npp_calc_clear
63	CALL turn_clear
64	CALL soilcarbon_clear
65	CALL constraints_clear
66	CALL establish_clear
67	CALL fire_clear
68	CALL gap_clear
69	CALL light_clear
70	CALL pftinout_clear
71	CALL alloc_clear
72	END SUBROUTINE StomateLpj_clear
73
74	SUBROUTINE StomateLpj (npts, dt_days, EndOfYear, EndOfMonth, &
75	neighbours, resolution, &
76	clay, herbivores, &
77	tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
78	litterhum_daily, soilhum_daily, &
79	maxmoiavail_lastyear, minmoiavail_lastyear, &
80	gdd0_lastyear, precip_lastyear, &
81	moiavail_month, moiavail_week, tlong_ref, t2m_month, t2m_week, &
82	tsoil_month, soilhum_month, &
83	gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
84	turnover_longterm, gpp_daily, time_lowgpp, &
85	time_hum_min, maxfpc_lastyear, resp_maint_part, &
86	PFTpresent, age, fireindex, firelitter, &
87	leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
88	senescence, when_growthinit, &
89	litterpart, litter, dead_leaves, carbon, black_carbon, lignin_struc, &
90	veget_max, veget, npp_longterm, lm_lastyearmax, veget_lastlight, &
91	everywhere, need_adjacent, RIP_time, &
92	lai, rprof,npp_daily, turnover_daily, turnover_time,&
93	control_moist, control_temp, soilcarbon_input, &
94	co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, &
95	height, deadleaf_cover, vcmax, vjmax, &
96	t_photo_min, t_photo_opt, t_photo_max,bm_to_litter, &
97	prod10,prod100,flux10, flux100, veget_max_new, &
98	convflux,cflux_prod10,cflux_prod100, harvest_above, carb_mass_total, lcchange, &
99	fpc_max)
100
101	!
102	! 0 declarations
103	!
104
105	! 0.1 input
106
107	! Domain size
108	INTEGER(i_std), INTENT(in) :: npts
109	! time step of Stomate in days
110	REAL(r_std), INTENT(in) :: dt_days
111	! indices of the 8 neighbours of each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
112	INTEGER(i_std), DIMENSION(npts,8), INTENT(in) :: neighbours
113	! resolution at each grid point in m (1=E-W, 2=N-S)
114	REAL(r_std), DIMENSION(npts,2), INTENT(in) :: resolution
115	! clay fraction
116	REAL(r_std), DIMENSION(npts), INTENT(in) :: clay
117	! time constant of probability of a leaf to be eaten by a herbivore (days)
118	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: herbivores
119	! daily surface temperatures (K)
120	REAL(r_std), DIMENSION(npts), INTENT(in) :: tsurf_daily
121	! daily soil temperatures (K)
122	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_daily
123	! daily 2 meter temperatures (K)
124	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_daily
125	! daily minimum 2 meter temperatures (K)
126	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_min_daily
127	! daily litter humidity
128	REAL(r_std), DIMENSION(npts), INTENT(in) :: litterhum_daily
129	! daily soil humidity
130	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_daily
131	! last year's maximum moisture availability
132	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxmoiavail_lastyear
133	! last year's minimum moisture availability
134	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: minmoiavail_lastyear
135	! last year's GDD0
136	REAL(r_std), DIMENSION(npts), INTENT(in) :: gdd0_lastyear
137	! lastyear's precipitation (mm/year)
138	REAL(r_std), DIMENSION(npts), INTENT(in) :: precip_lastyear
139	! "monthly" moisture availability
140	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_month
141	! "weekly" moisture availability
142	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_week
143	! "long term" 2 meter reference temperatures (K)
144	REAL(r_std), DIMENSION(npts), INTENT(in) :: tlong_ref
145	! "monthly" 2-meter temperatures (K)
146	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_month
147	! "weekly" 2-meter temperatures (K)
148	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_week
149	! "monthly" soil temperatures (K)
150	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_month
151	! "monthly" soil humidity
152	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_month
153	! growing degree days, threshold -5 deg C (for phenology)
154	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gdd_m5_dormance
155	! growing degree days, since midwinter (for phenology)
156	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gdd_midwinter
157	! number of chilling days, since leaves were lost (for phenology)
158	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ncd_dormance
159	! number of growing days, threshold -5 deg C (for phenology)
160	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ngd_minus5
161	! "long term" turnover rate (gC/(m**2 of ground)/year)
162	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: turnover_longterm
163	! daily gross primary productivity (gC/(m**2 of ground)/day)
164	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gpp_daily
165	! duration of dormance (d)
166	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: time_lowgpp
167	! time elapsed since strongest moisture availability (d)
168	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: time_hum_min
169	! last year's maximum fpc for each natural PFT, on ground
170	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear
171	! maintenance respiration of different plant parts (gC/day/m**2 of ground)
172	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: resp_maint_part
173	! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
174	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fpc_max
175
176	! 0.2 modified fields
177
178	! PFT exists
179	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent
180	! age (years)
181	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age
182	! Probability of fire
183	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: fireindex
184	! Longer term litter above the ground, gC/m**2 of ground
185	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: firelitter
186	! leaf age (days)
187	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age
188	! fraction of leaves in leaf age class
189	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
190	! biomass (gC/(m**2 of ground))
191	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass
192	! density of individuals (1/(m**2 of ground))
193	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind
194	! Winter too cold? between 0 and 1
195	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: adapted
196	! Winter sufficiently cold? between 0 and 1
197	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate
198	! is the plant senescent? (only for deciduous trees - carbohydrate reserve)
199	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence
200	! how many days ago was the beginning of the growing season
201	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit
202	! fraction of litter above the ground belonging to different PFTs
203	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout) :: litterpart
204	! metabolic and structural litter, above and below ground (gC/(m**2 of ground))
205	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs), INTENT(inout) :: litter
206	! dead leaves on ground, per PFT, metabolic and structural,
207	! in gC/(m**2 of ground)
208	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout) :: dead_leaves
209	! carbon pool: active, slow, or passive,(gC/(m**2 of ground))
210	REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon
211	! black carbon on the ground (gC/(m**2 of total ground))
212	REAL(r_std), DIMENSION(npts), INTENT(inout) :: black_carbon
213	! ratio Lignine/Carbon in structural litter, above and below ground,
214	! (gC/(m**2 of ground))
215	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout) :: lignin_struc
216	! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
217	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max
218	! fractional coverage on ground, taking into account LAI (=grid-scale fpc)
219	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget
220	! "long term" net primary productivity (gC/(m**2 of ground)/year)
221	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm
222	! last year's maximum leaf mass, for each PFT (gC/(m**2 of ground))
223	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax
224	! vegetation fractions (on ground) after last light competition
225	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_lastlight
226	! is the PFT everywhere in the grid box or very localized (after its introduction)
227	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere
228	! in order for this PFT to be introduced, does it have to be present in an
229	! adjacent grid box?
230	LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: need_adjacent
231	! How much time ago was the PFT eliminated for the last time (y)
232	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: RIP_time
233	! Turnover_time of leaves for grasses (d)
234	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: turnover_time
235
236	! 0.3 output
237
238	! leaf area index OF AN INDIVIDUAL PLANT
239	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lai
240	! root depth. This will, one day, be a prognostic variable. It will be calculated by
241	! STOMATE (save in restart file & give to hydrology module!), probably somewhere
242	! in the allocation routine. For the moment, it is prescribed.
243	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: rprof
244	! net primary productivity (gC/day/(m**2 of ground))
245	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: npp_daily
246	! Turnover rates (gC/(m**2 of ground)/day)
247	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: turnover_daily
248	! moisture control of heterotrophic respiration
249	REAL(r_std), DIMENSION(npts,nlevs), INTENT(inout) :: control_moist
250	! temperature control of heterotrophic respiration, above and below
251	REAL(r_std), DIMENSION(npts,nlevs), INTENT(inout) :: control_temp
252	! quantity of carbon going into carbon pools from litter decomposition
253	! (gC/(m**2 of ground)/day)
254	REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout) :: soilcarbon_input
255	! co2 taken up (gC/(m**2 of total ground)/day)
256	!NV devient 2D
257	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: co2_to_bm
258	! carbon emitted into the atmosphere by fire (living and dead biomass)
259	! (in gC/m**2 of total ground/day)
260	!NV devient 2D
261	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: co2_fire
262	! heterotrophic respiration (gC/day/m**2 of total ground)
263	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: resp_hetero
264	! maintenance respiration (gC/day/(m**2 of total ground))
265	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_maint
266	! growth respiration (gC/day/(m**2 of total ground))
267	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_growth
268	! height of vegetation (m)
269	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: height
270	! fraction of soil covered by dead leaves
271	REAL(r_std), DIMENSION(npts), INTENT(inout) :: deadleaf_cover
272	! Maximum rate of carboxylation
273	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: vcmax
274	! Maximum rate of RUbp regeneration
275	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: vjmax
276	! Minimum temperature for photosynthesis (deg C)
277	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: t_photo_min
278	! Optimum temperature for photosynthesis (deg C)
279	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: t_photo_opt
280	! Maximum temperature for photosynthesis (deg C)
281	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: t_photo_max
282	! conversion of biomass to litter (gC/(m**2 of ground)) / day
283	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: bm_to_litter
284	!
285	! new "maximal" coverage fraction of a PFT (LAI -> infinity)
286	REAL(r_std), DIMENSION(npts,nvm),INTENT(inout) :: veget_max_new
287
288	! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
289	! (10 or 100 + 1 : input from year of land cover change)
290	REAL(r_std),DIMENSION(npts,0:10), INTENT(inout) :: prod10
291	REAL(r_std),DIMENSION(npts,0:100), INTENT(inout) :: prod100
292	! annual release from the 10/100 year-turnover pool compartments
293	REAL(r_std),DIMENSION(npts,10), INTENT(inout) :: flux10
294	REAL(r_std),DIMENSION(npts,100), INTENT(inout) :: flux100
295	! release during first year following land cover change
296	REAL(r_std),DIMENSION(npts), INTENT(inout) :: convflux
297	! total annual release from the 10/100 year-turnover pool
298	REAL(r_std),DIMENSION(npts), INTENT(inout) :: cflux_prod10, cflux_prod100
299	! harvest above ground biomass for agriculture
300	REAL(r_std), DIMENSION(npts), INTENT(inout) :: harvest_above
301	! Carbon Mass total
302	REAL(r_std), DIMENSION(npts), INTENT(inout) :: carb_mass_total
303
304	! land cover change flag
305	LOGICAL, INTENT(in) :: lcchange
306
307	! Land cover change variables + EndOfYear
308	! Do update of yearly variables? This variable must be .TRUE. once a year
309	LOGICAL, INTENT(in) :: EndOfYear
310	! Do update of monthly variables ? This variable must be .TRUE. once a month
311	LOGICAL, INTENT(in) :: EndOfMonth
312
313	! 0.4 local
314
315	! total conversion of biomass to litter (gC/(m**2)) / day
316	REAL(r_std), DIMENSION(npts,nvm) :: tot_bm_to_litter
317	! total living biomass (gC/(m**2))
318	REAL(r_std), DIMENSION(npts,nvm) :: tot_live_biomass
319	! biomass increase, i.e. NPP per plant part
320	REAL(r_std), DIMENSION(npts,nvm,nparts) :: bm_alloc
321	! total turnover rate (gC/(m**2)) / day
322	REAL(r_std), DIMENSION(npts,nvm) :: tot_turnover
323	! total soil and litter carbon (gC/(m**2))
324	REAL(r_std), DIMENSION(npts,nvm) :: tot_litter_soil_carb
325	! total litter carbon (gC/(m**2))
326	REAL(r_std), DIMENSION(npts,nvm) :: tot_litter_carb
327	! total soil carbon (gC/(m**2))
328	REAL(r_std), DIMENSION(npts,nvm) :: tot_soil_carb
329	! Carbon Mass variation
330	REAL(r_std), DIMENSION(npts) :: carb_mass_variation
331	! crown area of individuals (m**2)
332	REAL(r_std), DIMENSION(npts,nvm) :: cn_ind
333	! woodmass of individuals (gC)
334	REAL(r_std), DIMENSION(npts,nvm) :: woodmass_ind
335	! fraction that goes into plant part
336	REAL(r_std), DIMENSION(npts,nvm,nparts) :: f_alloc
337	! space availability for trees
338	REAL(r_std), DIMENSION(npts) :: avail_tree
339	! space availability for grasses
340	REAL(r_std), DIMENSION(npts) :: avail_grass
341
342	INTEGER :: j
343
344	! total products remaining in the pool after the annual release
345	REAL(r_std),DIMENSION(npts) :: prod10_total, prod100_total
346	! total flux from conflux and the 10/100 year-turnover pool
347	REAL(r_std),DIMENSION(npts) :: cflux_prod_total
348
349	! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
350	REAL(r_std),DIMENSION(npts,nvm) :: veget_max_old
351
352	! fraction of individual dying this time step
353	REAL(r_std), DIMENSION(npts,nvm) :: mortality
354
355	REAL(r_std), DIMENSION(npts) :: vartmp
356
357	REAL(r_std), DIMENSION(npts,nvm) :: histvar
358
359	! =========================================================================
360
361	IF (bavard.GE.3) WRITE(numout,*) 'Entering stomate_lpj'
362
363	!
364	! 1 Initializations
365	!
366
367	!
368	! 1.1 set outputs to zero
369	!
370	co2_to_bm(:,:) = zero
371	co2_fire(:,:) = zero
372	npp_daily(:,:) = zero
373	turnover_daily(:,:,:) = zero
374	resp_maint(:,:) = zero
375	resp_growth(:,:) = zero
376	harvest_above(:) = zero
377
378	!
379	! 1.2 initialize some variables
380	!
381
382	bm_to_litter(:,:,:) = zero
383	cn_ind(:,:) = zero
384	woodmass_ind(:,:) = zero
385	veget_max_old(:,:) = veget_max(:,:)
386
387	! 1.3 Calculate some vegetation characteristics
388
389	!
390	! 1.3.1 Calculate some vegetation characteristics (cn_ind and height) from
391	! state variables if running DGVM or dynamic mortality in static cover mode
392	!
393	IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
394	IF(control%ok_dgvm) THEN
395	WHERE (ind(:,:).GT.min_stomate)
396	woodmass_ind(:,:) = &
397	((biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
398	+biomass(:,:,iheartabove)+biomass(:,:,iheartbelow)) &
399	*veget_max(:,:))/ind(:,:)
400	ENDWHERE
401	ELSE
402	WHERE (ind(:,:).GT.min_stomate)
403	woodmass_ind(:,:) = &
404	(biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
405	+biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/ind(:,:)
406	ENDWHERE
407	ENDIF
408
409	CALL crown (npts, PFTpresent, &
410	ind, biomass, woodmass_ind, &
411	veget_max, cn_ind, height)
412	ENDIF
413
414	!
415	! 1.3.2 Prescribe some vegetation characteristics if the vegetation is not dynamic
416	! IF the DGVM is not activated, the density of individuals and their crown
417	! areas don't matter, but they should be defined for the case we switch on
418	! the DGVM afterwards.
419	! At first call, if the DGVM is not activated, impose a minimum biomass for
420	! prescribed PFTs and declare them present.
421	!
422
423	CALL prescribe (npts, &
424	veget_max, PFTpresent, everywhere, when_growthinit, &
425	biomass, leaf_frac, ind, cn_ind)
426
427	!
428	! 2 climatic constraints for PFT presence and regenerativeness
429	! call this even when DGVM is not activated so that "adapted" and "regenerate"
430	! are kept up to date for the moment when the DGVM is activated.
431	!
432
433	CALL constraints (npts, dt_days, &
434	t2m_month, t2m_min_daily,when_growthinit, &
435	adapted, regenerate)
436
437	!
438	! 3 PFTs in and out, based on climate criteria
439	!
440
441	IF ( control%ok_dgvm ) THEN
442
443	!
444	! 3.1 do introduction/elimination
445	!
446
447	CALL pftinout (npts, dt_days, adapted, regenerate, &
448	neighbours, veget, veget_max, &
449	biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
450	PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
451	co2_to_bm, &
452	avail_tree, avail_grass)
453
454	!
455	! 3.2 reset attributes for eliminated PFTs.
456	! This also kills PFTs that had 0 leafmass during the last year. The message
457	! "... after pftinout" is misleading in this case.
458	!
459
460	CALL kill (npts, 'pftinout ', lm_lastyearmax, &
461	ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
462	lai, age, leaf_age, leaf_frac, npp_longterm, &
463	when_growthinit, everywhere, veget, veget_max, bm_to_litter)
464
465	!
466	! 3.3 calculate new crown area and maximum vegetation cover
467	!
468	!
469	! unsure whether this is really required
470	! - in theory this could ONLY be done at the END of stomate_lpj
471	!
472
473	! calculate woodmass of individual tree
474	WHERE ((ind(:,:).GT.min_stomate))
475	WHERE ( veget_max(:,:) .GT. min_stomate)
476	woodmass_ind(:,:) = &
477	((biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
478	+biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))*veget_max(:,:))/ind(:,:)
479	ELSEWHERE
480	woodmass_ind(:,:) =(biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
481	+biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/ind(:,:)
482	ENDWHERE
483
484	ENDWHERE
485
486	CALL crown (npts, PFTpresent, &
487	ind, biomass, woodmass_ind, &
488	veget_max, cn_ind, height)
489
490	ENDIF
491
492	!
493	! 4 phenology
494	!
495	CALL histwrite (hist_id_stomate, 'WHEN_GROWTHINIT', itime, when_growthinit, npts*nvm, horipft_index)
496	CALL histwrite (hist_id_stomate, 'TIME_LOWGPP', itime, time_lowgpp, npts*nvm, horipft_index)
497
498	WHERE(PFTpresent)
499	histvar=un
500	ELSEWHERE
501	histvar=zero
502	ENDWHERE
503	CALL histwrite (hist_id_stomate, 'PFTPRESENT', itime, histvar, npts*nvm, horipft_index)
504
505	WHERE(gdd_midwinter.EQ.undef)
506	histvar=val_exp
507	ELSEWHERE
508	histvar=gdd_midwinter
509	ENDWHERE
510	CALL histwrite (hist_id_stomate, 'GDD_MIDWINTER', itime, histvar, npts*nvm, horipft_index)
511
512	WHERE(ncd_dormance.EQ.undef)
513	histvar=val_exp
514	ELSEWHERE
515	histvar=ncd_dormance
516	ENDWHERE
517	CALL histwrite (hist_id_stomate, 'NCD_DORMANCE', itime, histvar, npts*nvm, horipft_index)
518
519	CALL phenology (npts, dt_days, PFTpresent, &
520	veget_max, &
521	tlong_ref, t2m_month, t2m_week, gpp_daily, &
522	maxmoiavail_lastyear, minmoiavail_lastyear, &
523	moiavail_month, moiavail_week, &
524	gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
525	senescence, time_lowgpp, time_hum_min, &
526	biomass, leaf_frac, leaf_age, &
527	when_growthinit, co2_to_bm)
528
529	!
530	! 5 allocation
531	!
532
533	CALL alloc (npts, dt_days, &
534	lai, veget_max, senescence, when_growthinit, &
535	moiavail_week, tsoil_month, soilhum_month, &
536	biomass, age, leaf_age, leaf_frac, rprof, f_alloc)
537
538	!
539	! 6 maintenance and growth respiration. NPP
540	!
541
542	CALL npp_calc (npts, dt_days, &
543	PFTpresent, &
544	tlong_ref, t2m_daily, tsoil_daily, lai, rprof, &
545	gpp_daily, f_alloc, bm_alloc, resp_maint_part,&
546	biomass, leaf_age, leaf_frac, age, &
547	resp_maint, resp_growth, npp_daily)
548
549	IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
550	CALL kill (npts, 'npp ', lm_lastyearmax, &
551	ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
552	lai, age, leaf_age, leaf_frac, npp_longterm, &
553	when_growthinit, everywhere, veget, veget_max, bm_to_litter)
554
555	! new provisional crown area and maximum vegetation cover after growth
556	IF(control%ok_dgvm) THEN
557	WHERE (ind(:,:).GT.min_stomate)
558	woodmass_ind(:,:) = &
559	((biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
560	+biomass(:,:,iheartabove)+biomass(:,:,iheartbelow)) &
561	*veget_max(:,:))/ind(:,:)
562	ENDWHERE
563	ELSE
564	WHERE (ind(:,:).GT.min_stomate)
565	woodmass_ind(:,:) = &
566	(biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
567	+biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/ind(:,:)
568	ENDWHERE
569	ENDIF
570
571	CALL crown (npts, PFTpresent, &
572	ind, biomass, woodmass_ind,&
573	veget_max, cn_ind, height)
574
575	ENDIF
576
577	!
578	! 7 fire.
579	!
580
581	CALL fire (npts, dt_days, litterpart, &
582	litterhum_daily, t2m_daily, lignin_struc, veget_max, &
583	fireindex, firelitter, biomass, ind, &
584	litter, dead_leaves, bm_to_litter, black_carbon, &
585	co2_fire)
586
587	IF ( control%ok_dgvm ) THEN
588
589	! reset attributes for eliminated PFTs
590
591	CALL kill (npts, 'fire ', lm_lastyearmax, &
592	ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
593	lai, age, leaf_age, leaf_frac, npp_longterm, &
594	when_growthinit, everywhere, veget, veget_max, bm_to_litter)
595
596	ENDIF
597
598	!
599	! 8 tree mortality. Does not depend on age, therefore does not change crown area.
600	!
601
602	CALL gap (npts, dt_days, &
603	npp_longterm, turnover_longterm, lm_lastyearmax, &
604	PFTpresent, biomass, ind, bm_to_litter, mortality)
605
606	IF ( control%ok_dgvm ) THEN
607
608	! reset attributes for eliminated PFTs
609
610	CALL kill (npts, 'gap ', lm_lastyearmax, &
611	ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
612	lai, age, leaf_age, leaf_frac, npp_longterm, &
613	when_growthinit, everywhere, veget, veget_max, bm_to_litter)
614
615	ENDIF
616
617	!
618	! 9 calculate vcmax, vjmax and photosynthesis temperatures
619	!
620
621	CALL vmax (npts, dt_days, &
622	leaf_age, leaf_frac, &
623	vcmax, vjmax)
624
625	CALL assim_temp (npts, tlong_ref, t2m_month, &
626	t_photo_min, t_photo_opt, t_photo_max)
627
628	!
629	! 10 leaf senescence and other turnover processes. New lai
630	!
631
632	CALL turn (npts, dt_days, PFTpresent, &
633	herbivores, &
634	maxmoiavail_lastyear, minmoiavail_lastyear, &
635	moiavail_week, moiavail_month,tlong_ref, t2m_month, t2m_week, veget_max, &
636	leaf_age, leaf_frac, age, lai, biomass, &
637	turnover_daily, senescence,turnover_time)
638
639	!
640	! 11 light competition
641	!
642
643	! IF ( control%ok_dgvm .OR. .NOT.(lpj_gap_const_mort) ) THEN
644	IF ( control%ok_dgvm ) THEN
645	!
646	! 11.1 do light competition
647	!
648
649	CALL light (npts, dt_days, &
650	veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
651	lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
652
653	!
654	! 11.2 reset attributes for eliminated PFTs
655	!
656
657	CALL kill (npts, 'light ', lm_lastyearmax, &
658	ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
659	lai, age, leaf_age, leaf_frac, npp_longterm, &
660	when_growthinit, everywhere, veget, veget_max, bm_to_litter)
661
662	ENDIF
663
664	!
665	! 12 establishment of saplings
666	!
667
668	IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort ) THEN
669
670	!
671	! 12.1 do establishment
672	!
673
674	CALL establish (npts, dt_days, PFTpresent, regenerate, &
675	neighbours, resolution, need_adjacent, herbivores, &
676	precip_lastyear, gdd0_lastyear, lm_lastyearmax, &
677	cn_ind, lai, avail_tree, avail_grass, npp_longterm, &
678	leaf_age, leaf_frac, &
679	ind, biomass, age, everywhere, co2_to_bm, veget_max, woodmass_ind)
680
681	!
682	! 12.2 calculate new crown area (and maximum vegetation cover)
683	!
684
685	CALL crown (npts, PFTpresent, &
686	ind, biomass, woodmass_ind, &
687	veget_max, cn_ind, height)
688
689	ENDIF
690
691	!
692	! 13 calculate final LAI and vegetation cover.
693	!
694
695	CALL cover (npts, cn_ind, ind, biomass, &
696	veget_max, veget_max_old, veget, &
697	lai, litter, carbon, turnover_daily, bm_to_litter)
698
699	!
700	! 14 the whole litter stuff:
701	! litter update, lignin content, PFT parts, litter decay,
702	! litter heterotrophic respiration, dead leaf soil cover.
703	! No vertical discretisation in the soil for litter decay.
704	!
705	! added by shilong for harvest
706	IF(harvest_agri) THEN
707	CALL harvest(npts, dt_days, veget_max, veget, &
708	bm_to_litter, turnover_daily, &
709	harvest_above)
710	ENDIF
711
712	! 15.1 Land cover change
713
714	!shilong adde turnover_daily
715	IF(EndOfYear) THEN
716	IF (lcchange) THEN
717	CALL lcchange_main (npts, dt_days, veget_max, veget_max_new, &
718	biomass, ind, age, PFTpresent, senescence, when_growthinit, &
719	everywhere, veget, &
720	co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, tree, cn_ind,flux10,flux100, &
721	!!$ prod10,prod100,prod10_total,prod100_total,&
722	!!$ convflux,cflux_prod_total,cflux_prod10,cflux_prod100,leaf_frac,&
723	prod10,prod100,convflux,cflux_prod10,cflux_prod100,leaf_frac,&
724	npp_longterm, lm_lastyearmax, litter, carbon)
725	ENDIF
726	ENDIF
727	!MM dÃ©placement pour initialisation correcte des grandeurs cumulÃ©es :
728	cflux_prod_total(:) = convflux(:) + cflux_prod10(:) + cflux_prod100(:)
729	prod10_total(:)=SUM(prod10,dim=2)
730	prod100_total(:)=SUM(prod100,dim=2)
731	!
732	! 16 total heterotrophic respiration
733
734	tot_soil_carb=zero
735	tot_litter_carb=zero
736	DO j=2,nvm
737
738	tot_litter_carb(:,j) = tot_litter_carb(:,j) + (litter(:,istructural,j,iabove) + &
739	& litter(:,imetabolic,j,iabove) + &
740	& litter(:,istructural,j,ibelow) + litter(:,imetabolic,j,ibelow))
741
742	tot_soil_carb(:,j) = tot_soil_carb(:,j) + (carbon(:,iactive,j) + &
743	& carbon(:,islow,j)+ carbon(:,ipassive,j))
744
745	ENDDO
746	tot_litter_soil_carb = tot_litter_carb + tot_soil_carb
747
748	tot_live_biomass = biomass(:,:,ileaf) + biomass(:,:,isapabove) + biomass(:,:,isapbelow) +&
749	& biomass(:,:,iheartabove) + biomass(:,:,iheartbelow) + &
750	& biomass(:,:,iroot)+ biomass(:,:,ifruit)+ biomass(:,:,icarbres)
751
752	tot_turnover = turnover_daily(:,:,ileaf) + turnover_daily(:,:,isapabove) + &
753	& turnover_daily(:,:,isapbelow) + turnover_daily(:,:,iheartabove) + &
754	& turnover_daily(:,:,iheartbelow) + turnover_daily(:,:,iroot) + &
755	& turnover_daily(:,:,ifruit) + turnover_daily(:,:,icarbres)
756
757	tot_bm_to_litter = bm_to_litter(:,:,ileaf) + bm_to_litter(:,:,isapabove) +&
758	& bm_to_litter(:,:,isapbelow) + bm_to_litter(:,:,iheartbelow) +&
759	& bm_to_litter(:,:,iheartabove) + bm_to_litter(:,:,iroot) + &
760	& bm_to_litter(:,:,ifruit) + bm_to_litter(:,:,icarbres)
761
762	carb_mass_variation(:)=-carb_mass_total(:)
763	carb_mass_total(:)=SUM((tot_live_biomass+tot_litter_carb+tot_soil_carb)*veget_max,dim=2) + &
764	& (prod10_total + prod100_total)
765	carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:)
766
767	!
768	! 17 history
769	!
770
771	! 2d
772
773	CALL histwrite (hist_id_stomate, 'RESOLUTION_X', itime, &
774	resolution(:,1), npts, hori_index)
775	CALL histwrite (hist_id_stomate, 'RESOLUTION_Y', itime, &
776	resolution(:,2), npts, hori_index)
777	CALL histwrite (hist_id_stomate, 'CONTFRAC', itime, &
778	contfrac(:), npts, hori_index)
779
780	CALL histwrite (hist_id_stomate, 'LITTER_STR_AB', itime, &
781	litter(:,istructural,:,iabove), npts*nvm, horipft_index)
782	CALL histwrite (hist_id_stomate, 'LITTER_MET_AB', itime, &
783	litter(:,imetabolic,:,iabove), npts*nvm, horipft_index)
784	CALL histwrite (hist_id_stomate, 'LITTER_STR_BE', itime, &
785	litter(:,istructural,:,ibelow), npts*nvm, horipft_index)
786	CALL histwrite (hist_id_stomate, 'LITTER_MET_BE', itime, &
787	litter(:,imetabolic,:,ibelow), npts*nvm, horipft_index)
788
789	CALL histwrite (hist_id_stomate, 'DEADLEAF_COVER', itime, &
790	deadleaf_cover, npts, hori_index)
791
792	CALL histwrite (hist_id_stomate, 'TOTAL_SOIL_CARB', itime, &
793	tot_litter_soil_carb, npts*nvm, horipft_index)
794	CALL histwrite (hist_id_stomate, 'CARBON_ACTIVE', itime, &
795	carbon(:,iactive,:), npts*nvm, horipft_index)
796	CALL histwrite (hist_id_stomate, 'CARBON_SLOW', itime, &
797	carbon(:,islow,:), npts*nvm, horipft_index)
798	CALL histwrite (hist_id_stomate, 'CARBON_PASSIVE', itime, &
799	carbon(:,ipassive,:), npts*nvm, horipft_index)
800
801	CALL histwrite (hist_id_stomate, 'T2M_MONTH', itime, &
802	t2m_month, npts, hori_index)
803	CALL histwrite (hist_id_stomate, 'T2M_WEEK', itime, &
804	t2m_week, npts, hori_index)
805
806	CALL histwrite (hist_id_stomate, 'HET_RESP', itime, &
807	resp_hetero(:,:), npts*nvm, horipft_index)
808
809	CALL histwrite (hist_id_stomate, 'BLACK_CARBON', itime, &
810	black_carbon, npts, hori_index)
811
812	CALL histwrite (hist_id_stomate, 'FIREINDEX', itime, &
813	fireindex(:,:), npts*nvm, horipft_index)
814	CALL histwrite (hist_id_stomate, 'LITTERHUM', itime, &
815	litterhum_daily, npts, hori_index)
816	CALL histwrite (hist_id_stomate, 'CO2_FIRE', itime, &
817	co2_fire, npts*nvm, horipft_index)
818	CALL histwrite (hist_id_stomate, 'CO2_TAKEN', itime, &
819	co2_to_bm, npts*nvm, horipft_index)
820	! land cover change
821	CALL histwrite (hist_id_stomate, 'CONVFLUX', itime, &
822	convflux, npts, hori_index)
823	CALL histwrite (hist_id_stomate, 'CFLUX_PROD10', itime, &
824	cflux_prod10, npts, hori_index)
825	CALL histwrite (hist_id_stomate, 'CFLUX_PROD100', itime, &
826	cflux_prod100, npts, hori_index)
827	CALL histwrite (hist_id_stomate, 'HARVEST_ABOVE', itime, &
828	harvest_above, npts, hori_index)
829
830	! 3d
831
832	CALL histwrite (hist_id_stomate, 'LAI', itime, &
833	lai, npts*nvm, horipft_index)
834	CALL histwrite (hist_id_stomate, 'VEGET', itime, &
835	veget, npts*nvm, horipft_index)
836	CALL histwrite (hist_id_stomate, 'VEGET_MAX', itime, &
837	veget_max, npts*nvm, horipft_index)
838	CALL histwrite (hist_id_stomate, 'NPP', itime, &
839	npp_daily, npts*nvm, horipft_index)
840	CALL histwrite (hist_id_stomate, 'GPP', itime, &
841	gpp_daily, npts*nvm, horipft_index)
842	CALL histwrite (hist_id_stomate, 'IND', itime, &
843	ind, npts*nvm, horipft_index)
844	CALL histwrite (hist_id_stomate, 'CN_IND', itime, &
845	cn_ind, npts*nvm, horipft_index)
846	CALL histwrite (hist_id_stomate, 'WOODMASS_IND', itime, &
847	woodmass_ind, npts*nvm, horipft_index)
848	CALL histwrite (hist_id_stomate, 'TOTAL_M', itime, &
849	tot_live_biomass, npts*nvm, horipft_index)
850	CALL histwrite (hist_id_stomate, 'LEAF_M', itime, &
851	biomass(:,:,ileaf), npts*nvm, horipft_index)
852	CALL histwrite (hist_id_stomate, 'SAP_M_AB', itime, &
853	biomass(:,:,isapabove), npts*nvm, horipft_index)
854	CALL histwrite (hist_id_stomate, 'SAP_M_BE', itime, &
855	biomass(:,:,isapbelow), npts*nvm, horipft_index)
856	CALL histwrite (hist_id_stomate, 'HEART_M_AB', itime, &
857	biomass(:,:,iheartabove), npts*nvm, horipft_index)
858	CALL histwrite (hist_id_stomate, 'HEART_M_BE', itime, &
859	biomass(:,:,iheartbelow), npts*nvm, horipft_index)
860	CALL histwrite (hist_id_stomate, 'ROOT_M', itime, &
861	biomass(:,:,iroot), npts*nvm, horipft_index)
862	CALL histwrite (hist_id_stomate, 'FRUIT_M', itime, &
863	biomass(:,:,ifruit), npts*nvm, horipft_index)
864	CALL histwrite (hist_id_stomate, 'RESERVE_M', itime, &
865	biomass(:,:,icarbres), npts*nvm, horipft_index)
866	CALL histwrite (hist_id_stomate, 'TOTAL_TURN', itime, &
867	tot_turnover, npts*nvm, horipft_index)
868	CALL histwrite (hist_id_stomate, 'LEAF_TURN', itime, &
869	turnover_daily(:,:,ileaf), npts*nvm, horipft_index)
870	CALL histwrite (hist_id_stomate, 'SAP_AB_TURN', itime, &
871	turnover_daily(:,:,isapabove), npts*nvm, horipft_index)
872	CALL histwrite (hist_id_stomate, 'ROOT_TURN', itime, &
873	turnover_daily(:,:,iroot), npts*nvm, horipft_index)
874	CALL histwrite (hist_id_stomate, 'FRUIT_TURN', itime, &
875	turnover_daily(:,:,ifruit), npts*nvm, horipft_index)
876	CALL histwrite (hist_id_stomate, 'TOTAL_BM_LITTER', itime, &
877	tot_bm_to_litter, npts*nvm, horipft_index)
878	CALL histwrite (hist_id_stomate, 'LEAF_BM_LITTER', itime, &
879	bm_to_litter(:,:,ileaf), npts*nvm, horipft_index)
880	CALL histwrite (hist_id_stomate, 'SAP_AB_BM_LITTER', itime, &
881	bm_to_litter(:,:,isapabove), npts*nvm, horipft_index)
882	CALL histwrite (hist_id_stomate, 'SAP_BE_BM_LITTER', itime, &
883	bm_to_litter(:,:,isapbelow), npts*nvm, horipft_index)
884	CALL histwrite (hist_id_stomate, 'HEART_AB_BM_LITTER', itime, &
885	bm_to_litter(:,:,iheartabove), npts*nvm, horipft_index)
886	CALL histwrite (hist_id_stomate, 'HEART_BE_BM_LITTER', itime, &
887	bm_to_litter(:,:,iheartbelow), npts*nvm, horipft_index)
888	CALL histwrite (hist_id_stomate, 'ROOT_BM_LITTER', itime, &
889	bm_to_litter(:,:,iroot), npts*nvm, horipft_index)
890	CALL histwrite (hist_id_stomate, 'FRUIT_BM_LITTER', itime, &
891	bm_to_litter(:,:,ifruit), npts*nvm, horipft_index)
892	CALL histwrite (hist_id_stomate, 'RESERVE_BM_LITTER', itime, &
893	bm_to_litter(:,:,icarbres), npts*nvm, horipft_index)
894	CALL histwrite (hist_id_stomate, 'MAINT_RESP', itime, &
895	resp_maint, npts*nvm, horipft_index)
896	CALL histwrite (hist_id_stomate, 'GROWTH_RESP', itime, &
897	resp_growth, npts*nvm, horipft_index)
898	CALL histwrite (hist_id_stomate, 'AGE', itime, &
899	age, npts*nvm, horipft_index)
900	CALL histwrite (hist_id_stomate, 'HEIGHT', itime, &
901	height, npts*nvm, horipft_index)
902	CALL histwrite (hist_id_stomate, 'MOISTRESS', itime, &
903	moiavail_week, npts*nvm, horipft_index)
904	CALL histwrite (hist_id_stomate, 'VCMAX', itime, &
905	vcmax, npts*nvm, horipft_index)
906	CALL histwrite (hist_id_stomate, 'TURNOVER_TIME', itime, &
907	turnover_time, npts*nvm, horipft_index)
908	! land cover change
909	CALL histwrite (hist_id_stomate, 'PROD10', itime, &
910	prod10, npts*11, horip11_index)
911	CALL histwrite (hist_id_stomate, 'PROD100', itime, &
912	prod100, npts*101, horip101_index)
913	CALL histwrite (hist_id_stomate, 'FLUX10', itime, &
914	flux10, npts*10, horip10_index)
915	CALL histwrite (hist_id_stomate, 'FLUX100', itime, &
916	flux100, npts*100, horip100_index)
917
918	IF ( hist_id_stomate_IPCC > 0 ) THEN
919	vartmp(:)=SUM(tot_live_biomassveget_max,dim=2)/1e3contfrac
920	CALL histwrite (hist_id_stomate_IPCC, "cVeg", itime, &
921	vartmp, npts, hori_index)
922	vartmp(:)=SUM(tot_litter_carbveget_max,dim=2)/1e3contfrac
923	CALL histwrite (hist_id_stomate_IPCC, "cLitter", itime, &
924	vartmp, npts, hori_index)
925	vartmp(:)=SUM(tot_soil_carbveget_max,dim=2)/1e3contfrac
926	CALL histwrite (hist_id_stomate_IPCC, "cSoil", itime, &
927	vartmp, npts, hori_index)
928	vartmp(:)=(prod10_total + prod100_total)/1e3
929	CALL histwrite (hist_id_stomate_IPCC, "cProduct", itime, &
930	vartmp, npts, hori_index)
931	vartmp(:)=carb_mass_variation/1e3/one_day*contfrac
932	CALL histwrite (hist_id_stomate_IPCC, "cMassVariation", itime, &
933	vartmp, npts, hori_index)
934	vartmp(:)=SUM(laiveget_max,dim=2)contfrac
935	CALL histwrite (hist_id_stomate_IPCC, "lai", itime, &
936	vartmp, npts, hori_index)
937	vartmp(:)=SUM(gpp_dailyveget_max,dim=2)/1e3/one_daycontfrac
938	CALL histwrite (hist_id_stomate_IPCC, "gpp", itime, &
939	vartmp, npts, hori_index)
940	vartmp(:)=SUM((resp_maint+resp_growth)veget_max,dim=2)/1e3/one_daycontfrac
941	CALL histwrite (hist_id_stomate_IPCC, "ra", itime, &
942	vartmp, npts, hori_index)
943	vartmp(:)=SUM(npp_dailyveget_max,dim=2)/1e3/one_daycontfrac
944	CALL histwrite (hist_id_stomate_IPCC, "npp", itime, &
945	vartmp, npts, hori_index)
946	vartmp(:)=SUM(resp_heteroveget_max,dim=2)/1e3/one_daycontfrac
947	CALL histwrite (hist_id_stomate_IPCC, "rh", itime, &
948	vartmp, npts, hori_index)
949	vartmp(:)=SUM(co2_fireveget_max,dim=2)/1e3/one_daycontfrac
950	CALL histwrite (hist_id_stomate_IPCC, "fFire", itime, &
951	vartmp, npts, hori_index)
952	vartmp(:)=harvest_above/1e3/one_day*contfrac
953	CALL histwrite (hist_id_stomate_IPCC, "fHarvest", itime, &
954	vartmp, npts, hori_index)
955	vartmp(:)=cflux_prod_total/1e3/one_day*contfrac
956	CALL histwrite (hist_id_stomate_IPCC, "fLuc", itime, &
957	vartmp, npts, hori_index)
958	vartmp(:)=(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero)-co2_fire) &
959	& veget_max,dim=2)-cflux_prod_total-harvest_above)/1e3/one_daycontfrac
960	CALL histwrite (hist_id_stomate_IPCC, "nbp", itime, &
961	vartmp, npts, hori_index)
962	vartmp(:)=SUM((tot_bm_to_litter + tot_turnover)veget_max,dim=2)/1e3/one_daycontfrac
963	CALL histwrite (hist_id_stomate_IPCC, "fVegLitter", itime, &
964	vartmp, npts, hori_index)
965	vartmp(:)=SUM(SUM(soilcarbon_input,dim=2)veget_max,dim=2)/1e3/one_daycontfrac
966	CALL histwrite (hist_id_stomate_IPCC, "fLitterSoil", itime, &
967	vartmp, npts, hori_index)
968	vartmp(:)=SUM(biomass(:,:,ileaf)veget_max,dim=2)/1e3contfrac
969	CALL histwrite (hist_id_stomate_IPCC, "cLeaf", itime, &
970	vartmp, npts, hori_index)
971	vartmp(:)=SUM((biomass(:,:,isapabove)+biomass(:,:,iheartabove))veget_max,dim=2)/1e3contfrac
972	CALL histwrite (hist_id_stomate_IPCC, "cWood", itime, &
973	vartmp, npts, hori_index)
974	vartmp(:)=SUM(( biomass(:,:,iroot) + biomass(:,:,isapbelow) + biomass(:,:,iheartbelow) ) &
975	& veget_max,dim=2)/1e3contfrac
976	CALL histwrite (hist_id_stomate_IPCC, "cRoot", itime, &
977	vartmp, npts, hori_index)
978	vartmp(:)=SUM(( biomass(:,:,icarbres) + biomass(:,:,ifruit))veget_max,dim=2)/1e3contfrac
979	CALL histwrite (hist_id_stomate_IPCC, "cMisc", itime, &
980	vartmp, npts, hori_index)
981	vartmp(:)=SUM((litter(:,istructural,:,iabove)+litter(:,imetabolic,:,iabove))veget_max,dim=2)/1e3contfrac
982	CALL histwrite (hist_id_stomate_IPCC, "cLitterAbove", itime, &
983	vartmp, npts, hori_index)
984	vartmp(:)=SUM((litter(:,istructural,:,ibelow)+litter(:,imetabolic,:,ibelow))veget_max,dim=2)/1e3contfrac
985	CALL histwrite (hist_id_stomate_IPCC, "cLitterBelow", itime, &
986	vartmp, npts, hori_index)
987	vartmp(:)=SUM(carbon(:,iactive,:)veget_max,dim=2)/1e3contfrac
988	CALL histwrite (hist_id_stomate_IPCC, "cSoilFast", itime, &
989	vartmp, npts, hori_index)
990	vartmp(:)=SUM(carbon(:,islow,:)veget_max,dim=2)/1e3contfrac
991	CALL histwrite (hist_id_stomate_IPCC, "cSoilMedium", itime, &
992	vartmp, npts, hori_index)
993	vartmp(:)=SUM(carbon(:,ipassive,:)veget_max,dim=2)/1e3contfrac
994	CALL histwrite (hist_id_stomate_IPCC, "cSoilSlow", itime, &
995	vartmp, npts, hori_index)
996	DO j=1,nvm
997	histvar(:,j)=veget_max(:,j)contfrac(:)100
998	ENDDO
999	CALL histwrite (hist_id_stomate_IPCC, "landCoverFrac", itime, &
1000	histvar, npts*nvm, horipft_index)
1001	!-
1002	vartmp(:)=zero
1003	DO j=2,nvm
1004	IF(is_deciduous(j)) THEN
1005	vartmp(:) = vartmp(:) + veget_max(:,j)contfrac100
1006	ENDIF
1007	ENDDO
1008	CALL histwrite (hist_id_stomate_IPCC, "treeFracPrimDec", itime, &
1009	vartmp, npts, hori_index)
1010	!-
1011	vartmp(:)=zero
1012	DO j=2,nvm
1013	IF(is_evergreen(j)) THEN
1014	vartmp(:) = vartmp(:) + veget_max(:,j)contfrac100
1015	ENDIF
1016	ENDDO
1017	CALL histwrite (hist_id_stomate_IPCC, "treeFracPrimEver", itime, &
1018	vartmp, npts, hori_index)
1019	!-
1020	vartmp(:)=zero
1021	DO j=2,nvm
1022	IF(is_c3(j)) THEN
1023	vartmp(:) = vartmp(:) + veget_max(:,j)contfrac100
1024	ENDIF
1025	ENDDO
1026	CALL histwrite (hist_id_stomate_IPCC, "c3PftFrac", itime, &
1027	vartmp, npts, hori_index)
1028	!-
1029	vartmp(:)=zero
1030	DO j=2,nvm
1031	IF(is_c4(j)) THEN
1032	vartmp(:) = vartmp(:) + veget_max(:,j)contfrac100
1033	ENDIF
1034	ENDDO
1035	CALL histwrite (hist_id_stomate_IPCC, "c4PftFrac", itime, &
1036	vartmp, npts, hori_index)
1037	!-
1038	vartmp(:)=SUM(resp_growthveget_max,dim=2)/1e3/one_daycontfrac
1039	CALL histwrite (hist_id_stomate_IPCC, "rGrowth", itime, &
1040	vartmp, npts, hori_index)
1041	vartmp(:)=SUM(resp_maintveget_max,dim=2)/1e3/one_daycontfrac
1042	CALL histwrite (hist_id_stomate_IPCC, "rMaint", itime, &
1043	vartmp, npts, hori_index)
1044	vartmp(:)=SUM(bm_alloc(:,:,ileaf)veget_max,dim=2)/1e3/one_daycontfrac
1045	CALL histwrite (hist_id_stomate_IPCC, "nppLeaf", itime, &
1046	vartmp, npts, hori_index)
1047	vartmp(:)=SUM(bm_alloc(:,:,isapabove)veget_max,dim=2)/1e3/one_daycontfrac
1048	CALL histwrite (hist_id_stomate_IPCC, "nppWood", itime, &
1049	vartmp, npts, hori_index)
1050	vartmp(:)=SUM(( bm_alloc(:,:,isapbelow) + bm_alloc(:,:,iroot) )veget_max,dim=2)/1e3/one_daycontfrac
1051	CALL histwrite (hist_id_stomate_IPCC, "nppRoot", itime, &
1052	vartmp, npts, hori_index)
1053
1054	CALL histwrite (hist_id_stomate_IPCC, 'RESOLUTION_X', itime, &
1055	resolution(:,1), npts, hori_index)
1056	CALL histwrite (hist_id_stomate_IPCC, 'RESOLUTION_Y', itime, &
1057	resolution(:,2), npts, hori_index)
1058	CALL histwrite (hist_id_stomate_IPCC, 'CONTFRAC', itime, &
1059	contfrac(:), npts, hori_index)
1060
1061	ENDIF
1062
1063	IF (bavard.GE.4) WRITE(numout,*) 'Leaving stomate_lpj'
1064
1065	END SUBROUTINE StomateLpj
1066
1067	SUBROUTINE harvest(npts, dt_days, veget_max, veget, &
1068	bm_to_litter, turnover_daily, &
1069	harvest_above)
1070
1071	! 0.1 input
1072
1073	! Domain size
1074	INTEGER, INTENT(in) :: npts
1075	! Time step (days)
1076	REAL(r_std), INTENT(in) :: dt_days
1077	! new "maximal" coverage fraction of a PFT (LAI -> infinity) on ground
1078	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max
1079
1080	! 0.2 modified fields
1081	! fractional coverage on natural/agricultural ground, taking into
1082	! account LAI (=grid-scale fpc)
1083	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget
1084	! conversion of biomass to litter (gC/(m**2 of nat/agri ground)) / day
1085	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: bm_to_litter
1086	! Turnover rates (gC/(m**2 of ground)/day)
1087	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: turnover_daily
1088	! harvest above ground biomass for agriculture
1089	REAL(r_std), DIMENSION(npts), INTENT(inout) :: harvest_above
1090
1091	! 0.4 local
1092
1093	! indices
1094	INTEGER(i_std) :: i, j
1095	! biomass increase (gC/(m**2 of ground))
1096	REAL(r_std) :: above_old
1097
1098	! yearly initialisation
1099	above_old = zero
1100	harvest_above = zero
1101
1102	DO i = 1, npts
1103	DO j = 1,nvm
1104	IF (.NOT. natural(j)) THEN
1105	above_old = turnover_daily(i,j,ileaf) + turnover_daily(i,j,isapabove) + &
1106	& turnover_daily(i,j,iheartabove) + turnover_daily(i,j,ifruit) + &
1107	& turnover_daily(i,j,icarbres) + turnover_daily(i,j,isapbelow) + &
1108	& turnover_daily(i,j,iheartbelow) + turnover_daily(i,j,iroot)
1109
1110	turnover_daily(i,j,ileaf) = turnover_daily(i,j,ileaf)*frac_turnover_daily
1111	turnover_daily(i,j,isapabove) = turnover_daily(i,j,isapabove)*frac_turnover_daily
1112	turnover_daily(i,j,isapbelow) = turnover_daily(i,j,isapbelow)*frac_turnover_daily
1113	turnover_daily(i,j,iheartabove) = turnover_daily(i,j,iheartabove)*frac_turnover_daily
1114	turnover_daily(i,j,iheartbelow) = turnover_daily(i,j,iheartbelow)*frac_turnover_daily
1115	turnover_daily(i,j,iroot) = turnover_daily(i,j,iroot)*frac_turnover_daily
1116	turnover_daily(i,j,ifruit) = turnover_daily(i,j,ifruit)*frac_turnover_daily
1117	turnover_daily(i,j,icarbres) = turnover_daily(i,j,icarbres)*frac_turnover_daily
1118	harvest_above(i) = harvest_above(i) + veget_max(i,j) * above_old *(un - frac_turnover_daily)
1119	END IF
1120	ENDDO
1121	ENDDO
1122
1123	!!$ harvest_above = harvest_above
1124	END SUBROUTINE harvest
1125	END MODULE stomate_lpj

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

Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_lpj.f90 @ 3850

Download in other formats: