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

Last change on this file since 943 was 943, checked in by didier.solyga, 10 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!
16MODULE 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
56CONTAINS
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_biomass*veget_max,dim=2)/1e3*contfrac
920       CALL histwrite (hist_id_stomate_IPCC, "cVeg", itime, &
921            vartmp, npts, hori_index)
922       vartmp(:)=SUM(tot_litter_carb*veget_max,dim=2)/1e3*contfrac
923       CALL histwrite (hist_id_stomate_IPCC, "cLitter", itime, &
924            vartmp, npts, hori_index)
925       vartmp(:)=SUM(tot_soil_carb*veget_max,dim=2)/1e3*contfrac
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(lai*veget_max,dim=2)*contfrac
935       CALL histwrite (hist_id_stomate_IPCC, "lai", itime, &
936            vartmp, npts, hori_index)
937       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)/1e3/one_day*contfrac
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_day*contfrac
941       CALL histwrite (hist_id_stomate_IPCC, "ra", itime, &
942            vartmp, npts, hori_index)
943       vartmp(:)=SUM(npp_daily*veget_max,dim=2)/1e3/one_day*contfrac
944       CALL histwrite (hist_id_stomate_IPCC, "npp", itime, &
945            vartmp, npts, hori_index)
946       vartmp(:)=SUM(resp_hetero*veget_max,dim=2)/1e3/one_day*contfrac
947       CALL histwrite (hist_id_stomate_IPCC, "rh", itime, &
948            vartmp, npts, hori_index)
949       vartmp(:)=SUM(co2_fire*veget_max,dim=2)/1e3/one_day*contfrac
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_day*contfrac
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_day*contfrac
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_day*contfrac
966       CALL histwrite (hist_id_stomate_IPCC, "fLitterSoil", itime, &
967            vartmp, npts, hori_index)
968       vartmp(:)=SUM(biomass(:,:,ileaf)*veget_max,dim=2)/1e3*contfrac
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)/1e3*contfrac
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)/1e3*contfrac
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)/1e3*contfrac
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)/1e3*contfrac
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)/1e3*contfrac
985       CALL histwrite (hist_id_stomate_IPCC, "cLitterBelow", itime, &
986            vartmp, npts, hori_index)
987       vartmp(:)=SUM(carbon(:,iactive,:)*veget_max,dim=2)/1e3*contfrac
988       CALL histwrite (hist_id_stomate_IPCC, "cSoilFast", itime, &
989            vartmp, npts, hori_index)
990       vartmp(:)=SUM(carbon(:,islow,:)*veget_max,dim=2)/1e3*contfrac
991       CALL histwrite (hist_id_stomate_IPCC, "cSoilMedium", itime, &
992            vartmp, npts, hori_index)
993       vartmp(:)=SUM(carbon(:,ipassive,:)*veget_max,dim=2)/1e3*contfrac
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)*contfrac*100
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)*contfrac*100
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)*contfrac*100
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)*contfrac*100
1033          ENDIF
1034       ENDDO
1035       CALL histwrite (hist_id_stomate_IPCC, "c4PftFrac", itime, &
1036            vartmp, npts, hori_index)
1037       !-
1038       vartmp(:)=SUM(resp_growth*veget_max,dim=2)/1e3/one_day*contfrac
1039       CALL histwrite (hist_id_stomate_IPCC, "rGrowth", itime, &
1040            vartmp, npts, hori_index)
1041       vartmp(:)=SUM(resp_maint*veget_max,dim=2)/1e3/one_day*contfrac
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_day*contfrac
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_day*contfrac
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_day*contfrac
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
1125END MODULE stomate_lpj
Note: See TracBrowser for help on using the repository browser.