source: branches/ORCHIDEE_EXT/ORCHIDEE/src_parameters/pft_parameters.f90 @ 64

Last change on this file since 64 was 64, checked in by didier.solyga, 14 years ago

Import first version of ORCHIDEE_EXT
File size: 48.0 KB
Line 
1!    09/2010
2! This is the module where we define the number of pfts and the values of the
3! parameters
4! author : D.Solyga
5
6MODULE pft_parameters
7
8USE constantes_mtc
9USE constantes
10USE ioipsl
11USE defprec
12
13IMPLICIT NONE
14
15
16  !-------------------------
17  ! PFT global
18  !------------------------
19  ! Number of vegetation types (see constantes_veg)
20  INTEGER(i_std) :: nvm = 13 
21  !-
22  !Table of conversion : we associate one pft to one mtc
23  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pft_to_mtc
24  !-
25  ! Description of the PFT
26  CHARACTER(len=34), ALLOCATABLE, SAVE, DIMENSION (:)  :: PFT_name
27  !
28  ! Flag l_first_define_pft
29  LOGICAL, SAVE   :: l_first_define_pft = .TRUE.
30
31  !----------------------
32  ! Vegetation structure
33  !----------------------
34  !-
35  ! 1 .Sechiba
36  !-
37  ! Value for veget_ori for tests in 0-dim simulations
38  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: veget_ori_fixed_test_1
39  ! laimax for maximum lai see also type of lai interpolation
40  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: llaimax
41  ! laimin for minimum lai see also type of lai interpolation
42  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: llaimin
43  ! prescribed height of vegetation.
44  ! Value for height_presc : one for each vegetation type
45  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: height_presc
46  ! Type of behaviour of the LAI evolution algorithm
47  ! for each vegetation type.
48  ! Value of type_of_lai, one for each vegetation type : mean or interp
49  CHARACTER(len=5),ALLOCATABLE, SAVE, DIMENSION (:) :: type_of_lai
50  ! Is the vegetation type a tree ?
51  LOGICAL,ALLOCATABLE, SAVE, DIMENSION (:) :: is_tree
52  !-
53  ! 2 .Stomate
54  !-
55  ! leaf type
56  ! 1=broad leaved tree, 2=needle leaved tree, 3=grass 4=bared ground
57  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leaf_tab
58  ! specif leaf area (m**2/gC)
59  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: sla
60  ! natural?
61  LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: natural
62
63
64  !----------------
65  ! Photosynthesis
66  !----------------
67  !-
68  ! 1 .CO2
69  !-
70  ! flag for C4 vegetation types
71  LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: is_c4
72  ! Slope of the gs/A relation (Ball & al.)
73  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: gsslope
74  ! intercept of the gs/A relation (Ball & al.)
75  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: gsoffset
76  ! values used for vcmax when STOMATE is not activated
77  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  ::  vcmax_fix
78  ! values used for vjmax when STOMATE is not activated
79  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: vjmax_fix
80  ! values used for photosynthesis tmin when STOMATE is not activated
81  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: co2_tmin_fix
82  ! values used for photosynthesis topt when STOMATE is not activated
83  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: co2_topt_fix
84  ! values used for photosynthesis tmax when STOMATE is not activated
85  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: co2_tmax_fix
86  !-
87  ! 2 .Stomate
88  !-
89  ! extinction coefficient of the Monsi&Seaki relationship (1953)
90  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ext_coeff ! = ext_coef in sechiba
91  ! Maximum rate of carboxylation
92  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vcmax_opt
93  ! Maximum rate of RUbp regeneration
94  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vjmax_opt
95  ! minimum photosynthesis temperature,
96  ! constant a of ax^2+bx+c (deg C),tabulated
97  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_min_a
98  ! minimum photosynthesis temperature,
99  ! constant b of ax^2+bx+c (deg C),tabulated
100  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tphoto_min_b 
101  ! minimum photosynthesis temperature,
102  ! constant c of ax^2+bx+c (deg C),tabulated
103  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tphoto_min_c 
104  ! optimum photosynthesis temperature,
105  ! constant a of ax^2+bx+c (deg C),tabulated
106  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: tphoto_opt_a 
107  ! optimum photosynthesis temperature,
108  ! constant b of ax^2+bx+c (deg C),tabulated
109  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: tphoto_opt_b 
110  ! optimum photosynthesis temperature,
111  ! constant c of ax^2+bx+c (deg C),tabulated
112  REAL(r_std),  ALLOCATABLE, SAVE, DIMENSION (:)  :: tphoto_opt_c
113  ! maximum photosynthesis temperature,
114  ! constant a of ax^2+bx+c (deg C), tabulated
115  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: tphoto_max_a
116  ! maximum photosynthesis temperature,
117  ! constant b of ax^2+bx+c (deg C), tabulated
118  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tphoto_max_b 
119  ! maximum photosynthesis temperature,
120  ! constant c of ax^2+bx+c (deg C), tabulated
121  REAL(r_std),  ALLOCATABLE, SAVE, DIMENSION (:)   :: tphoto_max_c 
122
123
124  !-----------------------
125  ! Respiration - stomate
126  !-----------------------
127  !
128!-! slope of maintenance respiration coefficient (1/K, 1/K^2, 1/K^3), used in the code
129  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)        :: maint_resp_slope
130  ! slope of maintenance respiration coefficient (1/K),
131  ! constant c of aT^2+bT+c , tabulated
132  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: maint_resp_slope_c
133  ! slope of maintenance respiration coefficient (1/K),
134  ! constant b of aT^2+bT+c , tabulated
135  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: maint_resp_slope_b
136  ! slope of maintenance respiration coefficient (1/K),
137  ! constant a of aT^2+bT+c , tabulated
138  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: maint_resp_slope_a
139!- ! maintenance respiration coefficient (g/g/day) at 0 deg C, used in the code
140  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: coeff_maint_zero
141  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
142  ! for leaves, tabulated
143  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_leaf
144  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
145  ! for sapwood above, tabulated
146  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_sapabove
147  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
148  ! for sapwood below, tabulated
149  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_sapbelow
150  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
151  ! for heartwood above, tabulated
152  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_heartabove
153  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
154  ! for heartwood below, tabulated
155  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_heartbelow
156  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
157  ! for roots, tabulated
158  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_root
159  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
160  ! for fruits, tabulated
161  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_fruit
162  ! maintenance respiration coefficient (g/g/day) at 0 deg C,
163  ! for carbohydrate reserve, tabulated
164  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::cm_zero_carbres
165 
166
167
168  !----------------
169  ! Fire - stomate
170  !----------------
171
172  ! flamability: critical fraction of water holding capacity
173  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: flam
174  ! fire resistance
175  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: resist
176
177
178
179  !---------------
180  ! Flux - LUC
181  !---------------
182  !
183  ! Coeff of biomass export for the year
184  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: coeff_lcchange_1
185  ! Coeff of biomass export for the decade
186  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: coeff_lcchange_10
187  ! Coeff of biomass export for the century
188  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: coeff_lcchange_100
189 
190
191  !-----------
192  ! Phenology
193  !-----------
194  !-
195  ! 1 .Stomate
196  !-
197  !
198  ! maximum LAI, PFT-specific
199  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lai_max 
200  ! which phenology model is used? (tabulated)
201  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_model
202  ! type of phenology
203  ! 0=bared ground 1=evergreen,  2=summergreen,  3=raingreen,  4=perennial
204  ! Pour l'instant, le phénotype de sol nu n'est pas géré aussi on traitera les sols
205  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_type
206  !-
207  ! 2. Leaf Onset
208  !-
209!-! critical gdd,tabulated (C), used in the code
210  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pheno_gdd_crit
211  ! critical gdd,tabulated (C), constant c of aT^2+bT+c
212  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_gdd_crit_c
213  ! critical gdd,tabulated (C), constant b of aT^2+bT+c
214  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::  pheno_gdd_crit_b
215  ! critical gdd,tabulated (C), constant a of aT^2+bT+c
216  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::  pheno_gdd_crit_a
217  ! critical ngd,tabulated. Threshold -5 degrees
218  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ngd_crit
219  ! critical temperature for the ncd vs. gdd function in phenology
220  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::  ncdgdd_temp
221  ! critical humidity (relative to min/max) for phenology
222  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::  hum_frac
223  ! minimum duration of dormance (d) for phenology
224  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lowgpp_time
225  ! minimum time elapsed since moisture minimum (d)
226  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: hum_min_time
227  ! sapwood -> heartwood conversion time (d)
228  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tau_sap
229  ! fruit lifetime (d)
230  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tau_fruit
231  ! fraction of primary leaf and root allocation put into reserve
232  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ecureuil
233  ! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
234  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alloc_min
235  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alloc_max
236  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: demi_alloc
237  !-
238  ! 3. Senescence
239  !-
240  ! length of death of leaves,tabulated (d)
241  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leaffall 
242  ! critical leaf age,tabulated (d)
243  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leafagecrit
244  ! type of senescence,tabulated
245  ! List of avaible types of senescence :
246  ! 'cold  ', 'dry   ', 'mixed ', 'none  '
247  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_type
248  ! critical relative moisture availability for senescence
249  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_hum
250  ! relative moisture availability above which
251  ! there is no humidity-related senescence
252  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: nosenescence_hum
253  ! maximum turnover time for grasse
254  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: max_turnover_time
255  ! minimum turnover time for grasse
256  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: min_turnover_time
257  ! minimum leaf age to allow senescence g
258  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: min_leaf_age_for_senescence
259!-! critical temperature for senescence (C), used in the code
260  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: senescence_temp
261  ! critical temperature for senescence (C),
262  ! constant c of aT^2+bT+c , tabulated
263  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::  senescence_temp_c
264  ! critical temperature for senescence (C),
265  ! constant b of aT^2+bT+c , tabulated
266  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_temp_b
267  ! critical temperature for senescence (C),
268  ! constant a of aT^2+bT+c , tabulated
269  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_temp_a
270
271
272  !-----------
273  ! DGVM
274  !-----------
275  !-
276  ! residence time (y) of trees
277  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: residence_time
278  ! critical tmin, tabulated (C)
279  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmin_crit
280  ! critical tcm, tabulated (C)
281  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::  tcm_crit
282
283
284  !-------------------------------
285  ! Evapotranspiration -  sechiba
286  !-------------------------------
287  !-
288  ! Structural resistance.
289  ! Value for rstruct_const : one for each vegetation type
290  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: rstruct_const
291  !
292  ! A vegetation dependent constant used in the calculation
293  ! of the surface resistance.
294  ! Value for kzero one for each vegetation type
295  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: kzero 
296
297
298  !-------------------
299  ! Water - sechiba
300  !-------------------
301  !-
302  ! Maximum field capacity for each of the vegetations (Temporary).
303  ! Value of wmax_veg : max quantity of water :
304  ! one for each vegetation type en Kg/M3
305  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: wmax_veg
306  ! Root profile description for the different vegetation types.
307  ! These are the factor in the exponential which gets
308  ! the root density as a function of depth
309  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: humcste
310
311
312  !------------------
313  ! Albedo - sechiba
314  !------------------
315  !-
316  ! Initial snow albedo value for each vegetation type
317  ! as it will be used in condveg_snow
318  ! Values are from the Thesis of S. Chalita (1992)
319  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snowa_ini
320  !
321  ! Decay rate of snow albedo value for each vegetation type
322  ! as it will be used in condveg_snow
323  ! Values are from the Thesis of S. Chalita (1992)
324  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snowa_dec
325  !
326  ! leaf albedo of vegetation type, visible albedo
327  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alb_leaf_vis
328  ! leaf albedo of vegetation type, near infrared albedo
329  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alb_leaf_nir
330  ! leaf albedo of vegetation type, VIS+NIR
331  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alb_leaf
332
333
334  !
335  !------------------------
336  !   Soil - vegetation
337  !------------------------
338
339  ! Table which contains the correlation between the soil types
340  ! and vegetation type. Two modes exist :
341  !  1) pref_soil_veg = 0 then we have an equidistribution
342  !     of vegetation on soil types
343  !  2) Else for each pft the prefered soil type is given :
344  !     1=sand, 2=loan, 3=clay
345  ! The variable is initialized in slowproc.
346  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pref_soil_veg
347  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pref_soil_veg_sand
348  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pref_soil_veg_loan
349  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pref_soil_veg_clay
350
351
352  !
353  !--------------------------------------------
354  ! Internal parameters used in stomate_data
355  !-------------------------------------------
356  !
357  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: lai_initmin
358  ! is pft a tree
359  LOGICAL,   ALLOCATABLE, SAVE, DIMENSION (:)    :: tree
360  ! sapling biomass (gC/ind)
361  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: bm_sapl
362  ! migration speed (m/year)
363  REAL(r_std),  ALLOCATABLE, SAVE, DIMENSION (:)    :: migrate
364  ! maximum stem diameter from which on crown area no longer increases (m)m
365  REAL(r_std),  ALLOCATABLE, SAVE, DIMENSION (:)     :: maxdia
366  ! crown of tree when sapling (m**2)
367  REAL(r_std),  ALLOCATABLE, SAVE, DIMENSION (:)    :: cn_sapl
368  ! time constant for leaf age discretisation (d)
369  REAL(r_std),  ALLOCATABLE, SAVE, DIMENSION (:)    :: leaf_timecst
370
371
372  !-------------------------------
373  ! Parameters already externalised (from sechiba)
374  ! to classify
375  !----------------------------------
376  !
377  ! used in hydrolc
378  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: throughfall_by_pft
379  ! used in diffuco   !! Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout
380  !! d'un potentiometre pour regler la resistance de la vegetation
381  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      ::  rveg_pft
382
383
384CONTAINS
385 !
386 SUBROUTINE pft_main 
387 
388   ! Local 
389    INTEGER(i_std) :: i
390
391
392
393   !----------------------
394   ! PFT global
395   !----------------------
396
397   IF(l_first_define_pft) THEN
398
399      IF(long_print) THEN
400         WRITE(numout,*) 'l_first_define_pft :we read the parameters from the def files'
401      ENDIF
402
403      ! Allocation of memory for the pfts-parameters
404      CALL pft_alloc
405
406      ! Initialisation of the correspondance table
407      pft_to_mtc (:) = zero_int
408     
409      ! Reading of the conrrespondance table in the .def file
410      CALL getin('PFT_TO_MTC',pft_to_mtc)
411
412     ! What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)?
413       DO i = 1, nvm
414          IF(pft_to_mtc(i) .GT. nvmc) THEN
415             WRITE(numout,*) "the MTC you chose doesn't exist"
416             STOP 'we stop reading pft_to_mtc'
417          ENDIF
418       ENDDO   
419
420
421      ! Verify if pft_to_mtc(1) = 1
422       IF(pft_to_mtc(1) .NE. 1) THEN
423          WRITE(numout,*) 'the first pft has to be the bare soil'
424          STOP 'we stop reading next values of pft_to_mtc'
425       ELSE
426          DO i = 2,nvm
427             IF(pft_to_mtc(i) .EQ.1) THEN
428                WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
429                STOP 'we stop reading pft_to_mtc'
430             ENDIF
431          ENDDO
432       ENDIF
433     
434   
435      ! Initialisation of the pfts-parameters
436      CALL pft_init
437
438      ! Could be useful : correspondance between the number of the pft
439      ! and the name of the associated mtc
440      DO i = 1,nvm
441         WRITE(numout,*) 'the PFT',i,'corresponds to the MTC : ',PFT_name(i) 
442      ENDDO
443
444
445      !------------------------------------------------------!
446      ! Declaration of tables 2D  which are used in the code !
447      !------------------------------------------------------!
448      !
449      !- pheno_gdd_crit
450      pheno_gdd_crit(:,:) = zero 
451      pheno_gdd_crit(:,1) = pheno_gdd_crit_c
452      pheno_gdd_crit(:,2) = pheno_gdd_crit_b         
453      pheno_gdd_crit(:,3) = pheno_gdd_crit_a 
454      !
455      !- senescence_temp
456      senescence_temp(:,:) = zero
457      senescence_temp(:,1) = senescence_temp_c
458      senescence_temp(:,2) = senescence_temp_b
459      senescence_temp(:,3) = senescence_temp_a
460      !
461      !- maint_resp_slope
462      maint_resp_slope(:,:) = zero
463      maint_resp_slope(:,1)= maint_resp_slope_c             
464      maint_resp_slope(:,2) = maint_resp_slope_b
465      maint_resp_slope(:,3) = maint_resp_slope_a
466      !
467      !-coeff_maint_zero
468      coeff_maint_zero (:,:) = zero
469      coeff_maint_zero(:,ileaf) = cm_zero_leaf
470      coeff_maint_zero(:,isapabove) = cm_zero_sapabove
471      coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow
472      coeff_maint_zero(:,iheartabove) = cm_zero_heartabove
473      coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow
474      coeff_maint_zero(:,iroot) = cm_zero_root
475      coeff_maint_zero(:,ifruit) = cm_zero_fruit
476      coeff_maint_zero(:,icarbres) = cm_zero_carbres
477      !
478      !-alb_leaf
479      alb_leaf(1:nvm) = alb_leaf_vis(1:nvm)
480      DO i = nvm+1, 2*nvm
481         alb_leaf(i) = alb_leaf_nir(i-nvm)
482      ENDDO
483      !- pref_soil_veg (see slowproc)
484
485
486   ELSE
487
488       l_first_define_pft = .FALSE.
489       
490       RETURN
491
492   ENDIF
493
494
495
496
497 END SUBROUTINE pft_main
498 !
499 !=
500 !
501 SUBROUTINE pft_init
502 
503   !------------
504   ! local
505   INTEGER(i_std) :: j,k
506   !------------
507
508   ! Initialisation !! not all the parameters are initialized
509
510   !----------------------
511   ! Vegetation structure
512   !----------------------
513   !-
514   ! 1 .Sechiba
515   !-
516   veget_ori_fixed_test_1 = zero
517   llaimax(:) = zero
518   llaimin(:) = zero
519   height_presc(:) = zero
520   !-
521   ! 2 .Stomate
522   !
523   leaf_tab(:) = zero_int
524   sla(:) = zero   
525   !----------------
526   ! Photosynthesis
527   !----------------
528   !-
529   ! 1 .CO2
530   !-
531   gsslope(:) = zero
532   gsoffset(:) = zero
533   vcmax_fix(:) = zero
534   vjmax_fix(:) = zero
535   co2_tmin_fix(:) = zero
536   co2_topt_fix(:) = zero
537   co2_tmax_fix(:) = zero
538   !-
539   ! 2 .Stomate
540   !-
541   ext_coeff(:) = zero
542   vcmax_opt(:) = zero
543   vjmax_opt(:) = zero
544   tphoto_min_a(:) = zero
545   tphoto_min_b(:) = zero
546   tphoto_min_c(:) = zero
547   tphoto_opt_a(:) = zero
548   tphoto_opt_b(:) = zero
549   tphoto_opt_c(:) = zero
550   tphoto_max_a(:) = zero
551   tphoto_max_b(:) = zero
552   tphoto_max_c(:) = zero
553   !----------------------
554   ! Respiration - stomate
555   !----------------------
556   !
557   maint_resp_slope_c(:) = zero
558   maint_resp_slope_b(:) = zero
559   maint_resp_slope_a(:) = zero
560   cm_zero_leaf(:) = zero
561   cm_zero_sapabove(:) = zero
562   cm_zero_sapbelow(:) = zero
563   cm_zero_heartabove(:) = zero
564   cm_zero_heartbelow(:) = zero
565   cm_zero_root(:) = zero
566   cm_zero_fruit(:) = zero
567   cm_zero_carbres(:) = zero
568   !----------------
569   ! Fire - stomate
570   !---------------
571   !
572   flam(:) = zero
573   resist(:) = zero
574   !----------------
575   ! Flux - LUC
576   !---------------
577   !
578   coeff_lcchange_1(:) = zero
579   coeff_lcchange_10(:) = zero
580   coeff_lcchange_100(:) = zero
581   !
582   !-----------
583   ! Phenology
584   !-----------
585   !-
586   ! 1 .Stomate
587   !-
588   lai_max(:) = zero
589   pheno_type(:) = zero_int
590   !-
591   ! 2. Leaf Onset
592   !-
593   pheno_gdd_crit_c(:) = zero
594   pheno_gdd_crit_b(:) = zero
595   pheno_gdd_crit_a(:) = zero
596   ngd_crit(:) = zero
597   ncdgdd_temp(:) = zero
598   hum_frac(:) = zero
599   lowgpp_time(:) = zero
600   hum_min_time(:) = zero
601   tau_sap(:) = zero
602   tau_fruit(:) = zero
603   ecureuil(:) = zero
604   alloc_min(:) = zero
605   alloc_max(:) = zero
606   demi_alloc(:) = zero 
607   !-
608   ! 3. Senescence
609   !-
610   leaffall(:) = zero
611   leafagecrit(:) = zero
612   senescence_hum(:) = zero
613   nosenescence_hum(:) = zero
614   max_turnover_time(:) = zero   
615   min_turnover_time(:) = zero 
616   min_leaf_age_for_senescence(:) = zero 
617   senescence_temp_c(:) = zero 
618   senescence_temp_b(:) = zero 
619   senescence_temp_a(:) = zero 
620   !-----------
621   ! DGVM
622   !-----------
623   !
624   residence_time(:) = zero
625   tmin_crit(:) = zero
626   tcm_crit(:) = zero
627   !-------------------------------
628   ! Evapotranspiration -  sechiba
629   !-------------------------------
630   !-
631   rstruct_const(:) = zero
632   kzero(:) = zero
633   !-------------------
634   ! Water - sechiba
635   !-------------------
636   !-
637   wmax_veg(:) = zero
638   humcste(:) = zero
639   !------------------
640   ! Albedo - sechiba
641   !------------------
642   !-
643   snowa_ini(:) = zero
644   snowa_dec(:) = zero
645   alb_leaf_vis(:) = zero
646   alb_leaf_nir(:) = zero
647   alb_leaf(:) = zero
648   !------------------------
649   !   Soil - vegetation
650   !------------------------
651   pref_soil_veg(:,:) = zero_int
652
653   !------------------------
654   !  Internal_parameters
655   !------------------------
656   lai_initmin(:) = zero
657   bm_sapl(:,:) = zero
658   migrate(:) = zero
659   maxdia(:) = zero
660   cn_sapl(:) = zero
661   leaf_timecst(:) = zero 
662   !-------------------------------
663   ! Parameters already externalised (from sechiba)
664   ! to classify
665   !----------------------------------
666   throughfall_by_pft(:) = zero
667   rveg_pft(:) = zero
668
669
670   !-------------------------------------------------------------!
671   ! Correspondance between the PFTs values and thes MTCs values !
672   !-------------------------------------------------------------! 
673 
674   DO j= 1, nvm
675
676
677      PFT_name(j) = MTC_name(pft_to_mtc(j))
678
679      !----------------------
680      ! Vegetation structure
681      !----------------------
682      !-
683      ! 1 .Sechiba
684      !-
685      veget_ori_fixed_test_1(j) = veget_ori_fixed_mtc(pft_to_mtc(j))
686      llaimax(j) = llaimax_mtc(pft_to_mtc(j))
687      llaimin(j) = llaimin_mtc(pft_to_mtc(j))
688      height_presc(j) = height_presc_mtc(pft_to_mtc(j))
689      type_of_lai(j) = type_of_lai_mtc(pft_to_mtc(j))
690      is_tree(j) = is_tree_mtc(pft_to_mtc(j))
691      !-
692      ! 2 .Stomate
693      !-
694      leaf_tab(j) = leaf_tab_mtc(pft_to_mtc(j))
695      sla(j) = sla_mtc(pft_to_mtc(j))
696      natural(j) = natural_mtc(pft_to_mtc(j))
697      !----------------
698      ! Photosynthesis
699      !----------------
700      !-
701      ! 1 .CO2
702      !-
703      is_c4(j) = is_c4_mtc(pft_to_mtc(j))
704      gsslope(j) = gsslope_mtc(pft_to_mtc(j))
705      gsoffset(j) = gsoffset_mtc(pft_to_mtc(j))
706      vcmax_fix(j) = vcmax_fix_mtc(pft_to_mtc(j))
707      vjmax_fix(j) = vjmax_fix_mtc(pft_to_mtc(j))
708      co2_tmin_fix(j) = co2_tmin_fix_mtc(pft_to_mtc(j))
709      co2_topt_fix(j) = co2_topt_fix_mtc(pft_to_mtc(j))
710      co2_tmax_fix(j) = co2_tmax_fix_mtc(pft_to_mtc(j))
711      !-
712      ! 2 .Stomate
713      !-
714      ext_coeff(j) = ext_coeff_mtc(pft_to_mtc(j))
715      vcmax_opt(j) = vcmax_opt_mtc(pft_to_mtc(j))
716      vjmax_opt(j) = vjmax_opt_mtc(pft_to_mtc(j)) 
717      tphoto_min_a(j) = tphoto_min_a_mtc(pft_to_mtc(j)) 
718      tphoto_min_b(j) = tphoto_min_b_mtc(pft_to_mtc(j))
719      tphoto_min_c(j) = tphoto_min_c_mtc(pft_to_mtc(j))
720      tphoto_opt_a(j) = tphoto_opt_a_mtc(pft_to_mtc(j))
721      tphoto_opt_b(j) = tphoto_opt_b_mtc(pft_to_mtc(j))
722      tphoto_opt_c(j) = tphoto_opt_c_mtc(pft_to_mtc(j))
723      tphoto_max_a(j) = tphoto_max_a_mtc(pft_to_mtc(j))
724      tphoto_max_b(j) = tphoto_max_b_mtc(pft_to_mtc(j))
725      tphoto_max_c(j) = tphoto_max_c_mtc(pft_to_mtc(j))
726      !----------------------
727      ! Respiration - stomate
728      !----------------------
729      maint_resp_slope_c = maint_resp_slope_c_mtc(pft_to_mtc(j))               
730      maint_resp_slope_b = maint_resp_slope_b_mtc(pft_to_mtc(j))
731      maint_resp_slope_a = maint_resp_slope_a_mtc(pft_to_mtc(j))
732      cm_zero_leaf(j)= cm_zero_leaf_mtc(pft_to_mtc(j))
733      cm_zero_sapabove(j) = cm_zero_sapabove_mtc(pft_to_mtc(j))
734      cm_zero_sapbelow(j) = cm_zero_sapbelow_mtc(pft_to_mtc(j)) 
735      cm_zero_heartabove(j) = cm_zero_heartabove_mtc(pft_to_mtc(j)) 
736      cm_zero_heartbelow(j) = cm_zero_heartbelow_mtc(pft_to_mtc(j))
737      cm_zero_root(j) =cm_zero_root_mtc(pft_to_mtc(j))
738      cm_zero_fruit(j) =cm_zero_fruit_mtc(pft_to_mtc(j))
739      cm_zero_carbres(j) = cm_zero_carbres_mtc(pft_to_mtc(j))
740      !----------------
741      ! Fire - stomate
742      !---------------
743      flam(j) = flam_mtc(pft_to_mtc(j))
744      resist(j) = resist_mtc(pft_to_mtc(j))
745      !----------------
746      ! Flux - LUC
747      !---------------
748      coeff_lcchange_1(j) = coeff_lcchange_1_mtc(pft_to_mtc(j))
749      coeff_lcchange_10(j) = coeff_lcchange_10_mtc(pft_to_mtc(j))
750      coeff_lcchange_100(j) = coeff_lcchange_100_mtc(pft_to_mtc(j))
751      !-----------
752      ! Phenology
753      !-----------
754      !-
755      ! 1 .Stomate
756      !-
757      lai_max(j) = lai_max_mtc(pft_to_mtc(j))
758      pheno_model(j) = pheno_model_mtc(pft_to_mtc(j))
759      pheno_type(j) = pheno_type_mtc(pft_to_mtc(j))
760      !-
761      ! 2. Leaf Onset
762      !-
763      pheno_gdd_crit_c(j) = pheno_gdd_crit_c_mtc(pft_to_mtc(j))
764      pheno_gdd_crit_b(j) = pheno_gdd_crit_b_mtc(pft_to_mtc(j))         
765      pheno_gdd_crit_a(j) = pheno_gdd_crit_a_mtc(pft_to_mtc(j))
766      ngd_crit(j) =  ngd_crit_mtc(pft_to_mtc(j))
767      ncdgdd_temp(j) = ncdgdd_temp_mtc(pft_to_mtc(j)) 
768      hum_frac(j) = hum_frac_mtc(pft_to_mtc(j))
769      lowgpp_time(j) = lowgpp_time_mtc(pft_to_mtc(j))
770      hum_min_time(j) = hum_min_time_mtc(pft_to_mtc(j))
771      tau_sap(j) =tau_sap_mtc(pft_to_mtc(j))
772      tau_fruit(j) =tau_fruit_mtc(pft_to_mtc(j))
773      ecureuil(j) = ecureuil_mtc(pft_to_mtc(j))
774      alloc_min(j) = alloc_min_mtc(pft_to_mtc(j))
775      alloc_max(j) = alloc_max_mtc(pft_to_mtc(j))
776      demi_alloc(j) = demi_alloc_mtc(pft_to_mtc(j))
777      !-
778      ! 3. Senescence
779      !-
780      leaffall(j) = leaffall_mtc(pft_to_mtc(j))
781      leafagecrit(j) = leafagecrit_mtc(pft_to_mtc(j))
782      senescence_type(j) = senescence_type_mtc(pft_to_mtc(j)) 
783      senescence_hum(j) = senescence_hum_mtc(pft_to_mtc(j)) 
784      nosenescence_hum(j) = nosenescence_hum_mtc(pft_to_mtc(j)) 
785      max_turnover_time(j) = max_turnover_time_mtc(pft_to_mtc(j))
786      min_turnover_time(j) = min_turnover_time_mtc(pft_to_mtc(j))
787      min_leaf_age_for_senescence(j) = min_leaf_age_for_senescence_mtc(pft_to_mtc(j))
788      senescence_temp_c(j) = senescence_temp_c_mtc(pft_to_mtc(j))
789      senescence_temp_b(j) = senescence_temp_b_mtc(pft_to_mtc(j))
790      senescence_temp_a(j) = senescence_temp_a_mtc(pft_to_mtc(j))
791      !-----------
792      ! DGVM
793      !-----------
794      residence_time(j) = residence_time_mtc(pft_to_mtc(j))
795      tmin_crit(j) = tmin_crit_mtc(pft_to_mtc(j))
796      tcm_crit(j) =  tcm_crit_mtc(pft_to_mtc(j))
797     
798      !-------------------------------
799      ! Evapotranspiration -  sechiba
800      !-------------------------------
801      !-
802      rstruct_const(j) = rstruct_const_mtc(pft_to_mtc(j))
803      kzero(j) = kzero_mtc(pft_to_mtc(j))
804      !-------------------
805      ! Water - sechiba
806      !-------------------
807      !-
808      wmax_veg(j) = wmax_veg_mtc(pft_to_mtc(j))
809      humcste(j) = humcste_mtc(pft_to_mtc(j))
810      !------------------
811      ! Albedo - sechiba
812      !------------------
813      !-
814      snowa_ini(j) = snowa_ini_mtc(pft_to_mtc(j))
815      snowa_dec(j) = snowa_dec_mtc(pft_to_mtc(j)) 
816      alb_leaf_vis(j) = alb_leaf_vis_mtc(pft_to_mtc(j)) 
817      alb_leaf_nir(j) = alb_leaf_nir_mtc(pft_to_mtc(j))
818      !------------------------
819      !   Soil - vegetation
820      !------------------------
821      pref_soil_veg_sand(j) = pref_soil_veg_sand_mtc(pft_to_mtc(j))
822      pref_soil_veg_loan(j) = pref_soil_veg_loan_mtc(pft_to_mtc(j))
823      pref_soil_veg_clay(j) = pref_soil_veg_clay_mtc(pft_to_mtc(j))
824      !-------------------------------
825      ! Parameters already externalised (from sechiba)
826      ! to classify
827      !----------------------------------
828      throughfall_by_pft(j) = throughfall_by_mtc(pft_to_mtc(j))
829      rveg_pft(j) = rveg_mtc(pft_to_mtc(j))
830
831
832   ENDDO
833
834
835 END SUBROUTINE pft_init
836 !
837 !=
838 !
839 SUBROUTINE pft_alloc
840
841   !------------------
842   ! local
843    LOGICAL ::  l_error
844    INTEGER :: ier
845   !-----------------
846
847   l_error = .FALSE.
848   ALLOCATE(pft_to_mtc(nvm),stat=ier)
849   l_error = l_error .OR. (ier .NE. 0)
850   ALLOCATE(PFT_name(nvm),stat=ier)
851   l_error = l_error .OR. (ier .NE. 0)
852   !-
853   ALLOCATE(veget_ori_fixed_test_1(nvm),stat=ier)
854   l_error = l_error .OR. (ier .NE. 0)
855   ALLOCATE(llaimax(nvm),stat=ier)
856   l_error = l_error .OR. (ier .NE. 0)
857   ALLOCATE(llaimin(nvm),stat=ier)
858   l_error = l_error .OR. (ier .NE. 0)
859   ALLOCATE(height_presc(nvm),stat=ier)
860   l_error = l_error .OR. (ier .NE. 0)
861   ALLOCATE(type_of_lai(nvm),stat=ier)
862   l_error = l_error .OR. (ier .NE. 0)   
863   ALLOCATE(is_tree(nvm),stat=ier)
864   l_error = l_error .OR. (ier .NE. 0)   
865   !-
866   ALLOCATE(leaf_tab(nvm),stat=ier)
867   l_error = l_error .OR. (ier .NE. 0)
868   ALLOCATE(sla(nvm),stat=ier)
869   l_error = l_error .OR. (ier .NE. 0)   
870   ALLOCATE(natural(nvm),stat=ier)
871   l_error = l_error .OR. (ier .NE. 0)
872   !-
873   ALLOCATE(is_c4(nvm),stat=ier)
874   l_error = l_error .OR. (ier .NE. 0)
875   ALLOCATE(gsslope(nvm),stat=ier)
876   l_error = l_error .OR. (ier .NE. 0)
877   ALLOCATE(gsoffset(nvm),stat=ier)
878   l_error = l_error .OR. (ier .NE. 0)
879   ALLOCATE(vcmax_fix(nvm),stat=ier)
880   l_error = l_error .OR. (ier .NE. 0)
881   ALLOCATE(vjmax_fix(nvm),stat=ier)
882   l_error = l_error .OR. (ier .NE. 0)
883   ALLOCATE(co2_tmin_fix(nvm),stat=ier)
884   l_error = l_error .OR. (ier .NE. 0)
885   ALLOCATE(co2_topt_fix(nvm),stat=ier)
886   l_error = l_error .OR. (ier .NE. 0)
887   ALLOCATE(co2_tmax_fix(nvm),stat=ier)
888   l_error = l_error .OR. (ier .NE. 0)
889   !-
890   ALLOCATE(ext_coeff(nvm),stat=ier)
891   l_error = l_error .OR. (ier .NE. 0) 
892   ALLOCATE(vcmax_opt(nvm),stat=ier)
893   l_error = l_error .OR. (ier .NE. 0) 
894   ALLOCATE(vjmax_opt(nvm),stat=ier)
895   l_error = l_error .OR. (ier .NE. 0)
896   ALLOCATE(tphoto_min_a(nvm),stat=ier)
897   l_error = l_error .OR. (ier .NE. 0) 
898   ALLOCATE(tphoto_min_b(nvm),stat=ier)
899   l_error = l_error .OR. (ier .NE. 0) 
900   ALLOCATE(tphoto_min_c(nvm),stat=ier)
901   l_error = l_error .OR. (ier .NE. 0) 
902   ALLOCATE(tphoto_opt_a(nvm),stat=ier)
903   l_error = l_error .OR. (ier .NE. 0) 
904   ALLOCATE(tphoto_opt_b(nvm),stat=ier)
905   l_error = l_error .OR. (ier .NE. 0) 
906   ALLOCATE(tphoto_opt_c(nvm),stat=ier)
907   l_error = l_error .OR. (ier .NE. 0) 
908   ALLOCATE(tphoto_max_a(nvm),stat=ier)
909   l_error = l_error .OR. (ier .NE. 0) 
910   ALLOCATE(tphoto_max_b(nvm),stat=ier)
911   l_error = l_error .OR. (ier .NE. 0) 
912   ALLOCATE(tphoto_max_c(nvm),stat=ier)
913   l_error = l_error .OR. (ier .NE. 0) 
914   !-
915   ALLOCATE(pheno_gdd_crit_c(nvm),stat=ier)
916   l_error = l_error .OR. (ier .NE. 0)
917   ALLOCATE(pheno_gdd_crit_b(nvm),stat=ier)
918   l_error = l_error .OR. (ier .NE. 0)
919   ALLOCATE(pheno_gdd_crit_a(nvm),stat=ier)
920   l_error = l_error .OR. (ier .NE. 0)
921   ALLOCATE(pheno_gdd_crit(nvm,3),stat=ier)
922   l_error = l_error .OR. (ier .NE. 0)
923   ALLOCATE(ngd_crit(nvm),stat=ier)
924   l_error = l_error .OR. (ier .NE. 0)
925   ALLOCATE(ncdgdd_temp(nvm),stat=ier)
926   l_error = l_error .OR. (ier .NE. 0)
927   ALLOCATE(hum_frac(nvm),stat=ier)
928   l_error = l_error .OR. (ier .NE. 0)
929   ALLOCATE(lowgpp_time(nvm),stat=ier)
930   l_error = l_error .OR. (ier .NE. 0)
931   ALLOCATE(hum_min_time(nvm),stat=ier)
932   l_error = l_error .OR. (ier .NE. 0)
933   ALLOCATE(tau_sap(nvm),stat=ier)
934   l_error = l_error .OR. (ier .NE. 0)
935   ALLOCATE(tau_fruit(nvm),stat=ier)
936   l_error = l_error .OR. (ier .NE. 0)
937   ALLOCATE(ecureuil(nvm),stat=ier)
938   l_error = l_error .OR. (ier .NE. 0)
939   ALLOCATE(alloc_min(nvm),stat=ier)
940   l_error = l_error .OR. (ier .NE. 0)
941   ALLOCATE(alloc_max(nvm),stat=ier)
942   l_error = l_error .OR. (ier .NE. 0)
943   ALLOCATE(demi_alloc(nvm),stat=ier)
944   l_error = l_error .OR. (ier .NE. 0)
945   !-
946   ALLOCATE(maint_resp_slope(nvm,3),stat=ier)
947   l_error = l_error .OR. (ier .NE. 0)
948   ALLOCATE(maint_resp_slope_c(nvm),stat=ier)
949   l_error = l_error .OR. (ier .NE. 0)
950   ALLOCATE(maint_resp_slope_b(nvm),stat=ier)
951   l_error = l_error .OR. (ier .NE. 0)
952   ALLOCATE(maint_resp_slope_a(nvm),stat=ier)
953   l_error = l_error .OR. (ier .NE. 0)
954   ALLOCATE(coeff_maint_zero(nvm,nparts),stat=ier)
955   l_error = l_error .OR. (ier .NE. 0)
956   ALLOCATE(cm_zero_leaf(nvm),stat=ier)
957   l_error = l_error .OR. (ier .NE. 0)
958   ALLOCATE(cm_zero_sapabove(nvm),stat=ier)
959   l_error = l_error .OR. (ier .NE. 0)
960   ALLOCATE(cm_zero_sapbelow(nvm),stat=ier)
961   l_error = l_error .OR. (ier .NE. 0)
962   ALLOCATE(cm_zero_heartabove(nvm),stat=ier)
963   l_error = l_error .OR. (ier .NE. 0)
964   ALLOCATE(cm_zero_heartbelow(nvm),stat=ier)
965   l_error = l_error .OR. (ier .NE. 0)
966   ALLOCATE(cm_zero_root(nvm),stat=ier)
967   l_error = l_error .OR. (ier .NE. 0)
968   ALLOCATE(cm_zero_fruit(nvm),stat=ier)
969   l_error = l_error .OR. (ier .NE. 0)
970   ALLOCATE(cm_zero_carbres(nvm),stat=ier)
971   l_error = l_error .OR. (ier .NE. 0)
972   !-
973   ALLOCATE(flam(nvm),stat=ier)
974   l_error = l_error .OR. (ier .NE. 0) 
975   ALLOCATE(resist(nvm),stat=ier)
976   l_error = l_error .OR. (ier .NE. 0) 
977   !-
978   ALLOCATE(coeff_lcchange_1(nvm),stat=ier)
979   l_error = l_error .OR. (ier .NE. 0)
980   ALLOCATE(coeff_lcchange_10(nvm),stat=ier)
981   l_error = l_error .OR. (ier .NE. 0)
982   ALLOCATE(coeff_lcchange_100(nvm),stat=ier)
983   l_error = l_error .OR. (ier .NE. 0)
984   !-
985   ALLOCATE(lai_max(nvm),stat=ier)
986   l_error = l_error .OR. (ier .NE. 0)
987   ALLOCATE(pheno_model(nvm),stat=ier)
988   l_error = l_error .OR. (ier .NE. 0) 
989   ALLOCATE(pheno_type(nvm),stat=ier)
990   l_error = l_error .OR. (ier .NE. 0) 
991   !-
992   ALLOCATE(leaffall(nvm),stat=ier)
993   l_error = l_error .OR. (ier .NE. 0)
994   ALLOCATE(leafagecrit(nvm),stat=ier)
995   l_error = l_error .OR. (ier .NE. 0)
996   ALLOCATE(senescence_type(nvm),stat=ier)
997   l_error = l_error .OR. (ier .NE. 0)
998   ALLOCATE(senescence_hum(nvm),stat=ier)
999   l_error = l_error .OR. (ier .NE. 0)
1000   ALLOCATE(nosenescence_hum(nvm),stat=ier)
1001   l_error = l_error .OR. (ier .NE. 0)
1002   ALLOCATE(max_turnover_time(nvm),stat=ier)
1003   l_error = l_error .OR. (ier .NE. 0)
1004   ALLOCATE(min_turnover_time(nvm),stat=ier)
1005   l_error = l_error .OR. (ier .NE. 0)
1006   ALLOCATE(min_leaf_age_for_senescence(nvm),stat=ier)
1007   l_error = l_error .OR. (ier .NE. 0)
1008   ALLOCATE(senescence_temp_c(nvm),stat=ier)
1009   l_error = l_error .OR. (ier .NE. 0)
1010   ALLOCATE(senescence_temp_b(nvm),stat=ier)
1011   l_error = l_error .OR. (ier .NE. 0)
1012   ALLOCATE(senescence_temp_a(nvm),stat=ier)
1013   l_error = l_error .OR. (ier .NE. 0)
1014   ALLOCATE(senescence_temp(nvm,3),stat=ier)
1015   l_error = l_error .OR. (ier .NE. 0)
1016   !-
1017   ALLOCATE(residence_time(nvm),stat=ier)
1018   l_error = l_error .OR. (ier .NE. 0)
1019   ALLOCATE(tmin_crit(nvm),stat=ier)
1020   l_error = l_error .OR. (ier .NE. 0)
1021   ALLOCATE(tcm_crit(nvm),stat=ier)
1022   l_error = l_error .OR. (ier .NE. 0)
1023   !-
1024   ALLOCATE(rstruct_const(nvm),stat=ier)
1025   l_error = l_error .OR. (ier .NE. 0)
1026   ALLOCATE(kzero(nvm),stat=ier)
1027   l_error = l_error .OR. (ier .NE. 0)
1028   !-
1029   ALLOCATE(wmax_veg(nvm),stat=ier)
1030   l_error = l_error .OR. (ier .NE. 0)
1031   ALLOCATE(humcste(nvm),stat=ier)
1032   l_error = l_error .OR. (ier .NE. 0)
1033   !-
1034   ALLOCATE(snowa_ini(nvm),stat=ier)
1035   l_error = l_error .OR. (ier .NE. 0)   
1036   ALLOCATE(snowa_dec(nvm),stat=ier)
1037   l_error = l_error .OR. (ier .NE. 0)
1038   ALLOCATE(alb_leaf_vis(nvm),stat=ier)
1039   l_error = l_error .OR. (ier .NE. 0)
1040   ALLOCATE(alb_leaf_nir(nvm),stat=ier)
1041   l_error = l_error .OR. (ier .NE. 0)
1042   ALLOCATE(alb_leaf(2*nvm),stat=ier)
1043   l_error = l_error .OR. (ier .NE. 0)
1044   !-
1045   ALLOCATE(pref_soil_veg_sand(nvm),stat=ier)
1046   l_error = l_error .OR. (ier .NE. 0)
1047   ALLOCATE(pref_soil_veg_loan(nvm),stat=ier)
1048   l_error = l_error .OR. (ier .NE. 0)
1049   ALLOCATE(pref_soil_veg_clay(nvm),stat=ier)
1050   l_error = l_error .OR. (ier .NE. 0)
1051   ALLOCATE(pref_soil_veg(nvm,nstm),stat=ier)
1052   l_error = l_error .OR. (ier .NE. 0)
1053   !-
1054   ALLOCATE(lai_initmin(nvm),stat=ier)
1055   l_error = l_error .OR. (ier .NE. 0)
1056   ALLOCATE(tree(nvm),stat=ier)
1057   l_error = l_error .OR. (ier .NE. 0)
1058   ALLOCATE(bm_sapl(nvm,nparts),stat=ier)
1059   l_error = l_error .OR. (ier .NE. 0)
1060   ALLOCATE(migrate(nvm),stat=ier)
1061   l_error = l_error .OR. (ier .NE. 0)
1062   ALLOCATE(maxdia(nvm),stat=ier)
1063   l_error = l_error .OR. (ier .NE. 0)
1064   ALLOCATE(cn_sapl(nvm),stat=ier)
1065   l_error = l_error .OR. (ier .NE. 0)
1066   ALLOCATE(leaf_timecst(nvm),stat=ier)
1067   l_error = l_error .OR. (ier .NE. 0) 
1068   !-
1069   ALLOCATE(throughfall_by_pft(nvm),stat=ier)
1070   l_error = l_error .OR. (ier .NE. 0)   
1071   ALLOCATE (rveg_pft(nvm),stat=ier)
1072   l_error = l_error .OR. (ier .NE. 0) 
1073
1074
1075
1076   IF (l_error) THEN
1077       STOP 'pft _alloc : error in memory allocation'
1078   ENDIF
1079
1080 END SUBROUTINE pft_alloc
1081 !
1082 !=
1083 !
1084 SUBROUTINE pft_clear
1085
1086   l_first_define_pft = .TRUE.
1087
1088   IF(ALLOCATED(pft_to_mtc))DEALLOCATE(pft_to_mtc)
1089   IF(ALLOCATED(PFT_name))DEALLOCATE(PFT_name)
1090   !-
1091   IF(ALLOCATED(veget_ori_fixed_test_1))DEALLOCATE(veget_ori_fixed_test_1)   
1092   IF(ALLOCATED(llaimax))DEALLOCATE(llaimax)
1093   IF(ALLOCATED(llaimin))DEALLOCATE(llaimin)
1094   IF(ALLOCATED(height_presc))DEALLOCATE(height_presc)   
1095   IF(ALLOCATED(type_of_lai))DEALLOCATE(type_of_lai)
1096   IF(ALLOCATED(is_tree))DEALLOCATE(is_tree)
1097   !-
1098   IF(ALLOCATED(leaf_tab))DEALLOCATE(leaf_tab)
1099   IF(ALLOCATED(sla))DEALLOCATE(sla)
1100   IF(ALLOCATED(natural))DEALLOCATE(natural)
1101   !-
1102   IF(ALLOCATED(is_c4))DEALLOCATE(is_c4) 
1103   IF(ALLOCATED(gsslope))DEALLOCATE(gsslope)
1104   IF(ALLOCATED(gsoffset))DEALLOCATE(gsoffset)
1105   IF(ALLOCATED(vcmax_fix))DEALLOCATE(vcmax_fix)
1106   IF(ALLOCATED(vjmax_fix))DEALLOCATE(vjmax_fix)
1107   IF(ALLOCATED(co2_tmin_fix))DEALLOCATE(co2_tmin_fix)
1108   IF(ALLOCATED(co2_topt_fix))DEALLOCATE(co2_topt_fix)
1109   IF(ALLOCATED(co2_tmax_fix))DEALLOCATE(co2_tmax_fix) 
1110   !-
1111   IF(ALLOCATED(ext_coeff))DEALLOCATE(ext_coeff)
1112   IF(ALLOCATED(vcmax_opt))DEALLOCATE(vcmax_opt)
1113   IF(ALLOCATED(vjmax_opt))DEALLOCATE(vjmax_opt)
1114   IF(ALLOCATED(tphoto_min_a))DEALLOCATE(tphoto_min_a)
1115   IF(ALLOCATED(tphoto_min_b))DEALLOCATE(tphoto_min_b)
1116   IF(ALLOCATED(tphoto_min_c))DEALLOCATE(tphoto_min_c)
1117   IF(ALLOCATED(tphoto_opt_a))DEALLOCATE(tphoto_opt_a)
1118   IF(ALLOCATED(tphoto_opt_b))DEALLOCATE(tphoto_opt_b)
1119   IF(ALLOCATED(tphoto_opt_c))DEALLOCATE(tphoto_opt_c)
1120   IF(ALLOCATED(tphoto_max_a))DEALLOCATE(tphoto_max_a)
1121   IF(ALLOCATED(tphoto_max_b))DEALLOCATE(tphoto_max_b)
1122   IF(ALLOCATED(tphoto_max_c))DEALLOCATE(tphoto_max_c)
1123   !-
1124   IF(ALLOCATED(maint_resp_slope))DEALLOCATE(maint_resp_slope)
1125   IF(ALLOCATED(maint_resp_slope_c))DEALLOCATE(maint_resp_slope_c)
1126   IF(ALLOCATED(maint_resp_slope_b))DEALLOCATE(maint_resp_slope_b)
1127   IF(ALLOCATED(maint_resp_slope_a))DEALLOCATE(maint_resp_slope_a)
1128   IF(ALLOCATED(coeff_maint_zero))DEALLOCATE(coeff_maint_zero)
1129   IF(ALLOCATED(cm_zero_leaf))DEALLOCATE(cm_zero_leaf)
1130   IF(ALLOCATED(cm_zero_sapabove))DEALLOCATE(cm_zero_sapabove)
1131   IF(ALLOCATED(cm_zero_sapbelow))DEALLOCATE(cm_zero_sapbelow)
1132   IF(ALLOCATED(cm_zero_heartabove))DEALLOCATE(cm_zero_heartabove)
1133   IF(ALLOCATED(cm_zero_heartbelow))DEALLOCATE(cm_zero_heartbelow)
1134   IF(ALLOCATED(cm_zero_root))DEALLOCATE(cm_zero_root)
1135   IF(ALLOCATED(cm_zero_fruit))DEALLOCATE(cm_zero_fruit)
1136   IF(ALLOCATED(cm_zero_carbres))DEALLOCATE(cm_zero_carbres)
1137   !-
1138   IF(ALLOCATED(flam))DEALLOCATE(flam)
1139   IF(ALLOCATED(resist))DEALLOCATE(resist)
1140   !-
1141   IF(ALLOCATED(coeff_lcchange_1))DEALLOCATE(coeff_lcchange_1)
1142   IF(ALLOCATED(coeff_lcchange_10))DEALLOCATE(coeff_lcchange_10)
1143   IF(ALLOCATED(coeff_lcchange_100))DEALLOCATE(coeff_lcchange_100)
1144   !-
1145   IF(ALLOCATED(lai_max)) DEALLOCATE(lai_max)
1146   IF(ALLOCATED(pheno_model))DEALLOCATE(pheno_model)
1147   IF(ALLOCATED(pheno_type))DEALLOCATE(pheno_type)
1148   !-
1149   IF(ALLOCATED(pheno_gdd_crit_c))DEALLOCATE(pheno_gdd_crit_c)
1150   IF(ALLOCATED(pheno_gdd_crit_b))DEALLOCATE(pheno_gdd_crit_b)
1151   IF(ALLOCATED(pheno_gdd_crit_a))DEALLOCATE(pheno_gdd_crit_a)
1152   IF(ALLOCATED(pheno_gdd_crit))DEALLOCATE(pheno_gdd_crit)
1153   IF(ALLOCATED(ngd_crit))DEALLOCATE(ngd_crit)
1154   IF(ALLOCATED(ncdgdd_temp))DEALLOCATE(ncdgdd_temp)
1155   IF(ALLOCATED(hum_frac))DEALLOCATE(hum_frac)
1156   IF(ALLOCATED(lowgpp_time))DEALLOCATE(lowgpp_time)   
1157   IF(ALLOCATED(hum_min_time))DEALLOCATE(hum_min_time)
1158   IF(ALLOCATED(tau_sap))DEALLOCATE(tau_sap)
1159   IF(ALLOCATED(tau_fruit))DEALLOCATE(tau_fruit)
1160   IF(ALLOCATED(ecureuil))DEALLOCATE(ecureuil)
1161   IF(ALLOCATED(alloc_min))DEALLOCATE(alloc_min)
1162   IF(ALLOCATED(alloc_max))DEALLOCATE(alloc_max)
1163   IF(ALLOCATED(demi_alloc))DEALLOCATE(demi_alloc)
1164   !-
1165   IF(ALLOCATED(leaffall))DEALLOCATE(leaffall)
1166   IF(ALLOCATED(leafagecrit))DEALLOCATE(leafagecrit)
1167   IF(ALLOCATED(senescence_type))DEALLOCATE(senescence_type)
1168   IF(ALLOCATED(senescence_hum))DEALLOCATE(senescence_hum)
1169   IF(ALLOCATED(nosenescence_hum))DEALLOCATE(nosenescence_hum)
1170   IF(ALLOCATED(max_turnover_time))DEALLOCATE(max_turnover_time)
1171   IF(ALLOCATED(min_turnover_time))DEALLOCATE(min_turnover_time)
1172   IF(ALLOCATED(min_leaf_age_for_senescence))DEALLOCATE(min_leaf_age_for_senescence)
1173   !-
1174   IF(ALLOCATED(senescence_temp_c))DEALLOCATE(senescence_temp_c)
1175   IF(ALLOCATED(senescence_temp_b))DEALLOCATE(senescence_temp_b)
1176   IF(ALLOCATED(senescence_temp_a))DEALLOCATE(senescence_temp_a)
1177   IF(ALLOCATED(senescence_temp))DEALLOCATE(senescence_temp)
1178   !-
1179   IF(ALLOCATED(residence_time))DEALLOCATE(residence_time)
1180   IF(ALLOCATED(tmin_crit))DEALLOCATE(tmin_crit)
1181   IF(ALLOCATED(tcm_crit))DEALLOCATE(tcm_crit)
1182   !-
1183   IF(ALLOCATED(rstruct_const))DEALLOCATE(rstruct_const)
1184   IF(ALLOCATED(kzero))DEALLOCATE(kzero)
1185   !-
1186   IF(ALLOCATED(wmax_veg))DEALLOCATE(wmax_veg)
1187   IF(ALLOCATED(humcste))DEALLOCATE(humcste)
1188   !-
1189   IF(ALLOCATED(snowa_ini))DEALLOCATE(snowa_ini)
1190   IF(ALLOCATED(snowa_dec))DEALLOCATE(snowa_dec)
1191   IF(ALLOCATED(alb_leaf_vis))DEALLOCATE(alb_leaf_vis)
1192   IF(ALLOCATED(alb_leaf_nir))DEALLOCATE(alb_leaf_nir)   
1193   IF(ALLOCATED(alb_leaf))DEALLOCATE(alb_leaf)
1194   !-
1195   IF(ALLOCATED(pref_soil_veg_sand))DEALLOCATE(pref_soil_veg_sand)
1196   IF(ALLOCATED(pref_soil_veg_loan))DEALLOCATE(pref_soil_veg_loan)
1197   IF(ALLOCATED(pref_soil_veg_clay))DEALLOCATE(pref_soil_veg_clay)
1198   IF(ALLOCATED(pref_soil_veg))DEALLOCATE(pref_soil_veg)
1199   !-
1200   IF(ALLOCATED(lai_initmin))DEALLOCATE(lai_initmin)
1201   IF(ALLOCATED(tree))DEALLOCATE(tree)
1202   IF(ALLOCATED(bm_sapl))DEALLOCATE(bm_sapl)
1203   IF(ALLOCATED(migrate))DEALLOCATE(migrate)
1204   IF(ALLOCATED(maxdia))DEALLOCATE(maxdia)
1205   IF(ALLOCATED(cn_sapl))DEALLOCATE(cn_sapl)
1206   IF(ALLOCATED(leaf_timecst))DEALLOCATE(leaf_timecst)
1207   !-
1208   IF(ALLOCATED(throughfall_by_pft))DEALLOCATE(throughfall_by_pft)
1209   IF (ALLOCATED(rveg_pft))DEALLOCATE(rveg_pft)
1210
1211
1212 END SUBROUTINE pft_clear
1213
1214 SUBROUTINE getin_sechiba_pft_parameters
1215 
1216  LOGICAL, SAVE ::  first_call = .TRUE.
1217
1218  IF(first_call) THEN
1219
1220     !----------------------
1221     ! Vegetation structure
1222     !---------------------
1223     !     
1224     CALL getin('LLAIMIN',llaimin)
1225     CALL getin('TYPE_OF_LAI',type_of_lai)
1226     CALL getin('IS_TREE',is_tree)
1227     ! No calling to getin for
1228     ! veget_ori_fixed_test_1, llaimax and height_presc
1229     ! getin will be called in slowproc.f90
1230     
1231     !-----------------
1232     ! Photosynthesis
1233     !-----------------
1234     !-
1235     CALL getin('IS_C4',is_c4)
1236     CALL getin('GSSLOPE',gsslope)
1237     CALL getin('GSOFFSET',gsoffset)
1238     CALL getin('VCMAX_FIX',vcmax_fix)
1239     CALL getin('VJMAX_FIX',vjmax_fix)
1240     CALL getin('CO2_TMIN_FIX',co2_tmin_fix)
1241     CALL getin('CO2_TOPT_FIX',co2_topt_fix)
1242     CALL getin('CO2_TMAX_FIX',co2_tmax_fix)
1243     CALL getin('EXT_COEFF',ext_coeff)
1244     
1245     !-------------------------------
1246     ! Evapotranspiration -  sechiba
1247     !-------------------------------
1248     !
1249     CALL getin('RSTRUCT_CONST',rstruct_const)
1250     CALL getin('KZERO',kzero)
1251     
1252     !-------------------
1253     ! Water - sechiba
1254     !-------------------
1255     !
1256     CALL getin('WMAX_VEG',wmax_veg)
1257     ! humcste is called in slowproc.f90 (problem with the flag)
1258     
1259     !------------------
1260     ! Albedo - sechiba
1261     !------------------
1262     !
1263     CALL getin('SNOWA_INI',snowa_ini)
1264     CALL getin('SNOWA_DEC',snowa_dec)
1265     CALL getin('ALB_LEAF_VIS',alb_leaf_vis)
1266     CALL getin('ALB_LEAF_NIR',alb_leaf_nir)
1267
1268     !------------------------
1269     !   Soil - vegetation
1270     !------------------------
1271     !
1272     CALL getin('PREF_SOIL_VEG_SAND',pref_soil_veg_sand)
1273     CALL getin('PREF_SOIL_VEG_LOAN',pref_soil_veg_loan)         
1274     CALL getin('PREF_SOIL_VEG_CLAY',pref_soil_veg_clay)
1275
1276  ENDIF
1277
1278END SUBROUTINE getin_sechiba_pft_parameters
1279
1280
1281SUBROUTINE getin_stomate_pft_parameters
1282
1283  LOGICAL, SAVE ::  first_call = .TRUE.
1284
1285  IF(first_call) THEN
1286
1287     !----------------------
1288     ! Vegetation structure
1289     !---------------------
1290     !
1291     CALL getin('LEAF_TAB',leaf_tab)
1292     CALL getin('SLA',sla)
1293     CALL getin('NATURAL',natural)
1294     
1295     !-----------------
1296     ! Photosynthesis
1297     !-----------------
1298     !
1299     CALL getin('VCMAX_OPT',vcmax_opt)
1300     CALL getin('VJMAX_OPT',vjmax_opt)
1301     CALL getin('TPHOTO_MIN_A',tphoto_min_a)
1302     CALL getin('TPHOTO_MIN_B',tphoto_min_b)
1303     CALL getin('TPHOTO_MIN_C',tphoto_min_c)
1304     CALL getin('TPHOTO_OPT_A',tphoto_opt_a)
1305     CALL getin('TPHOTO_OPT_B',tphoto_opt_b)
1306     CALL getin('TPHOTO_OPT_C',tphoto_opt_c)
1307     CALL getin('TPHOTO_MAX_A',tphoto_max_a)
1308     CALL getin('TPHOTO_MAX_B',tphoto_max_b)
1309     CALL getin('TPHOTO_MAX_C',tphoto_max_c)
1310     
1311     !----------------------
1312     ! Respiration - stomate
1313     !----------------------
1314     !
1315     CALL getin('MAINT_RESP_SLOPE_C',maint_resp_slope_c) 
1316     CALL getin('MAINT_RESP_SLOPE_B',maint_resp_slope_b)
1317     CALL getin('MAINT_RESP_SLOPE_A',maint_resp_slope_a)
1318     CALL getin('CM_ZERO_LEAF',cm_zero_leaf)
1319     CALL getin('CM_ZERO_SAPABOVE',cm_zero_sapabove)
1320     CALL getin('CM_ZERO_SAPBELOW',cm_zero_sapbelow)
1321     CALL getin('CM_ZERO_HEARTABOVE',cm_zero_heartabove)
1322     CALL getin('CM_ZERO_HEARTBELOW',cm_zero_heartbelow)
1323     CALL getin('CM_ZERO_ROOT',cm_zero_root)
1324     CALL getin('CM_ZERO_FRUIT',cm_zero_fruit)
1325     CALL getin('CM_ZERO_CARBRES',cm_zero_carbres)
1326     
1327     !----------------
1328     ! Fire - stomate
1329     !---------------
1330     !
1331     CALL getin('FLAM',flam)
1332     CALL getin('RESIST',resist)
1333     
1334     !----------------
1335     ! Flux - LUC
1336     !---------------
1337     !
1338     CALL getin('COEFF_LCCHANGE_1',coeff_lcchange_1)
1339     CALL getin('COEFF_LCCHANGE_10',coeff_lcchange_10)
1340     CALL getin('COEFF_LCCHANGE_100',coeff_lcchange_100)
1341
1342     !-----------
1343     ! Phenology
1344     !-----------
1345     !-
1346     ! 1 .Stomate
1347     !-
1348     CALL getin('LAI_MAX',lai_max)
1349     CALL getin('PHENO_MODEL',pheno_model)
1350     CALL getin('PHENO_TYPE',pheno_type)
1351     !-
1352     ! 2. Leaf Onset
1353     !-
1354     CALL getin('PHENO_GDD_CRIT_C',pheno_gdd_crit_c)
1355     CALL getin('PHENO_GDD_CRIT_B',pheno_gdd_crit_b)
1356     CALL getin('PHENO_GDD_CRIT_A',pheno_gdd_crit_a)
1357     CALL getin('NGD_CRIT',ngd_crit)
1358     CALL getin('NCDGDD_TEMP', ncdgdd_temp)
1359     CALL getin('HUM_FRAC', hum_frac)
1360     CALL getin('LOWGPP_TIME', lowgpp_time)
1361     CALL getin('HUM_MIN_TIME', hum_min_time)
1362     CALL getin('TAU_SAP',tau_sap)
1363     CALL getin('TAU_FRUIT',tau_fruit)
1364     CALL getin('ECUREUIL',ecureuil)
1365     CALL getin('ALLOC_MIN',alloc_min)
1366     CALL getin('ALLOC_MAX',alloc_max)
1367     CALL getin('DEMI_ALLOC',demi_alloc)
1368     !-
1369     ! 3. Senescence
1370     !-
1371     CALL getin('LEAFFALL',leaffall)
1372     CALL getin('LEAFAGECRIT',leafagecrit) 
1373     CALL getin('SENESCENCE_TYPE', senescence_type) 
1374     CALL getin('SENESCENCE_HUM', senescence_hum)
1375     CALL getin('NOSENESCENCE_HUM', nosenescence_hum) 
1376     CALL getin('MAX_TURNOVER_TIME',max_turnover_time)
1377     CALL getin('MIN_TURNOVER_TIME',min_turnover_time)
1378     CALL getin('MIN_LEAF_AGE_FOR_SENESCENCE', min_leaf_age_for_senescence)
1379     CALL getin('SENESCENCE_TEMP_C',senescence_temp_c)
1380     CALL getin('SENESCENCE_TEMP_B',senescence_temp_b)
1381     CALL getin('SENESCENCE_TEMP_A',senescence_temp_a)
1382     
1383     !-----------
1384     ! DGVM
1385     !-----------
1386     CALL getin('RESIDENCE_TIME',residence_time)
1387     CALL getin('TMIN_CRIT',tmin_crit)
1388     CALL getin('TCM_CRIT',tcm_crit)
1389       
1390  ENDIF
1391 
1392  END SUBROUTINE getin_stomate_pft_parameters
1393
1394END MODULE pft_parameters
Note: See TracBrowser for help on using the repository browser.