source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_parameters/pft_parameters_var.f90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
  1. Zhang publication on coupling factor
File size: 41.1 KB
Line 
1! =================================================================================================================================
2! MODULE       : pft_parameters_var
3!
4! CONTACT      : orchidee-help _at_ listes.ipsl.fr
5!
6! LICENCE      : IPSL (2011)
7! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF        This module contains the variables in function of plant funtional type (pft).
10!!
11!!\n DESCRIPTION: This module contains the declarations for the externalized variables in function of the
12!!                plant foncional type(pft). \n
13!!                The module is already USE in module pft_parameters. Therefor no need to USE it seperatly except
14!!                if the subroutines in module pft_parameters are not needed.\n
15!!
16!! RECENT CHANGE(S): None
17!!
18!! REFERENCE(S) : None
19!!
20!! SVN          :
21!! $HeadURL: $
22!! $Date: 2019-12-16 12:11:50 +0100 (Mon, 16 Dec 2019) $
23!! $Revision: 6393 $
24!! \n
25!_ ================================================================================================================================
26
27MODULE pft_parameters_var
28
29  USE defprec
30 
31  IMPLICIT NONE
32
33
34  !
35  ! PFT GLOBAL
36  !
37  INTEGER(i_std), SAVE :: nvm = 13                               !! Number of vegetation types (2-N, unitless)
38!$OMP THREADPRIVATE(nvm)
39
40  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pft_to_mtc  !! Table of conversion : we associate one pft to one metaclass
41                                                                 !! (1-13, unitless)
42!$OMP THREADPRIVATE(pft_to_mtc)
43
44  CHARACTER(LEN=34), ALLOCATABLE, SAVE, DIMENSION(:) :: PFT_name !! Description of the PFT (unitless)
45!$OMP THREADPRIVATE(PFT_name)
46
47  LOGICAL, SAVE   :: l_first_pft_parameters = .TRUE.             !! To keep first call trace of the module (true/false)
48!$OMP THREADPRIVATE(l_first_pft_parameters)
49
50  !
51  ! VEGETATION STRUCTURE
52  !
53  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_tab       !! leaf type (1-4, unitless)
54                                                                    !! 1=broad leaved tree, 2=needle leaved tree,
55                                                                    !! 3=grass 4=bare ground
56!$OMP THREADPRIVATE(leaf_tab)
57
58  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_model  !! which phenology model is used? (tabulated) (unitless)
59!$OMP THREADPRIVATE(pheno_model)
60
61  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tree               !! Is the vegetation type a tree ? (true/false)
62!$OMP THREADPRIVATE(is_tree)
63
64  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_deciduous          !! Is PFT deciduous ? (true/false)
65!$OMP THREADPRIVATE(is_deciduous)
66
67  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_evergreen          !! Is PFT evegreen ? (true/false)
68!$OMP THREADPRIVATE(is_evergreen)
69
70  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_needleleaf         !! Is PFT needleleaf ? (true/false)
71!$OMP THREADPRIVATE(is_needleleaf)
72 
73  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tropical           !! Is PFT tropical ? (true/false)
74!$OMP THREADPRIVATE(is_tropical)
75
76  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: natural               !! natural? (true/false)
77!$OMP THREADPRIVATE(natural)
78
79  CHARACTER(len=5), ALLOCATABLE, SAVE, DIMENSION(:) :: type_of_lai  !! Type of behaviour of the LAI evolution algorithm
80                                                                    !! for each vegetation type.
81                                                                    !! Value of type_of_lai, one for each vegetation type :
82                                                                    !! mean or interp
83!$OMP THREADPRIVATE(type_of_lai)
84
85  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: veget_ori_fixed_test_1 !! Value for veget_ori for tests in 0-dim simulations
86                                                                         !! (0-1, unitless)
87!$OMP THREADPRIVATE(veget_ori_fixed_test_1)
88
89  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimax                !! laimax for maximum lai see also type of lai
90                                                                         !! interpolation
91                                                                         !! @tex $(m^2.m^{-2})$ @endtex
92!$OMP THREADPRIVATE(llaimax)
93
94  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimin                !! laimin for minimum lai see also type of lai
95                                                                         !! interpolation
96                                                                         !! @tex $(m^2.m^{-2})$ @endtex
97!$OMP THREADPRIVATE(llaimin)
98
99  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_presc           !! prescribed height of vegetation.(m)
100                                                                         !! Value for height_presc : one for each vegetation type
101!$OMP THREADPRIVATE(height_presc)
102
103  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: z0_over_height        !! Factor to calculate roughness height from
104                                                                        !! vegetation height (unitless)   
105!$OMP THREADPRIVATE(z0_over_height)
106
107  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ratio_z0m_z0h         !! Ratio between z0m and z0h
108!$OMP THREADPRIVATE(ratio_z0m_z0h)
109
110  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) ::  rveg_pft              !! Potentiometer to set vegetation resistance (unitless)
111                                                                         !! Nathalie on March 28th, 2006 - from Fred Hourdin,
112!$OMP THREADPRIVATE(rveg_pft)
113
114  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sla                    !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex
115!$OMP THREADPRIVATE(sla)
116
117  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: availability_fact      !! calculate dynamic mortality in lpj_gap
118!$OMP THREADPRIVATE(availability_fact)
119
120  !
121  ! EVAPOTRANSPIRATION (sechiba)
122  !
123  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: rstruct_const          !! Structural resistance.
124                                                                         !! Value for rstruct_const : one for each vegetation type
125                                                                         !! @tex $(s.m^{-1})$ @endtex
126!$OMP THREADPRIVATE(rstruct_const)
127
128  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kzero                  !! A vegetation dependent constant used in the calculation
129                                                                         !! of the surface resistance.
130                                                                         !! Value for kzero one for each vegetation type
131                                                                         !! @tex $(kg.m^2.s^{-1})$ @endtex
132!$OMP THREADPRIVATE(kzero)
133
134  !
135  ! WATER (sechiba)
136  !
137  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: wmax_veg  !! Volumetric available soil water capacity in each PFT
138                                                            !! @tex $(kg.m^{-3} of soil)$ @endtex
139!$OMP THREADPRIVATE(wmax_veg)
140
141  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: humcste   !! Root profile description for the different vegetation types.
142                                                            !! These are the factor in the exponential which gets
143                                                            !! the root density as a function of depth
144                                                            !! @tex $(m^{-1})$ @endtex
145!$OMP THREADPRIVATE(humcste)
146
147  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: throughfall_by_pft !! Percent by PFT of precip that is not intercepted by the canopy
148!$OMP THREADPRIVATE(throughfall_by_pft)
149
150  !
151  ! ALBEDO (sechiba)
152  !
153  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_aged_vis !! Minimum snow albedo value for each vegetation type
154                                                                 !! after aging (dirty old snow), visible albedo (unitless)
155                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
156!$OMP THREADPRIVATE(snowa_aged_vis)
157
158  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_aged_nir !! Minimum snow albedo value for each vegetation type
159                                                                 !! after aging (dirty old snow), near infrared albedo (unitless)
160                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
161!$OMP THREADPRIVATE(snowa_aged_nir)
162
163  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec_vis  !! Decay rate of snow albedo value for each vegetation type
164                                                                 !! as it will be used in condveg_snow, visible albedo (unitless)
165                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
166!$OMP THREADPRIVATE(snowa_dec_vis)
167
168  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec_nir  !! Decay rate of snow albedo value for each vegetation type
169                                                                 !! as it will be used in condveg_snow, near infrared albedo (unitless)
170                                                                 !! Source : Values are from the Thesis of S. Chalita (1992)
171!$OMP THREADPRIVATE(snowa_dec_nir)
172
173  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_vis  !! leaf albedo of vegetation type, visible albedo (unitless)
174!$OMP THREADPRIVATE(alb_leaf_vis)
175
176  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_nir  !! leaf albedo of vegetation type, near infrared albedo (unitless)
177!$OMP THREADPRIVATE(alb_leaf_nir)
178
179  !
180  ! SOIL - VEGETATION
181  !
182  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pref_soil_veg      !! Table which contains the correlation between the soil
183                                                                        !! types and vegetation type. Two modes exist :
184                                                                        !! 1) pref_soil_veg = 0 then we have an equidistribution
185                                                                        !!    of vegetation on soil types
186                                                                        !! 2) Else for each pft the prefered soil type is given :
187                                                                        !!    1=sand, 2=loan, 3=clay
188                                                                        !! This variable is initialized in slowproc.(1-3, unitless)
189!$OMP THREADPRIVATE(pref_soil_veg)
190
191  !
192  ! PHOTOSYNTHESIS
193  !
194  !-
195  ! 1. CO2
196  !-
197  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_c4             !! flag for C4 vegetation types (true/false)
198!$OMP THREADPRIVATE(is_c4)
199
200  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vcmax_fix     !! values used for vcmax when STOMATE is not activated
201                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
202!$OMP THREADPRIVATE(vcmax_fix)
203
204  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: downregulation_co2_coeff !! Coefficient for CO2 downregulation if downregulation_co2 (used for CMIP6 6.1.0-6.1.10) (unitless)
205!$OMP THREADPRIVATE(downregulation_co2_coeff)
206
207  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: downregulation_co2_coeff_new !! Coefficient for CO2 downregulation if downregulation_co2_new (used for CMIP6 6.1.11) (unitless)
208!$OMP THREADPRIVATE(downregulation_co2_coeff_new)
209
210  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmC         !! Energy of activation for KmC (J mol-1)
211!$OMP THREADPRIVATE(E_KmC)                                                               
212  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmO         !! Energy of activation for KmO (J mol-1)
213!$OMP THREADPRIVATE(E_KmO)         
214REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Sco           !! Energy of activation for Sco (J mol-1)
215!$OMP THREADPRIVATE(E_Sco)           
216  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_gamma_star  !! Energy of activation for gamma_star (J mol-1)
217!$OMP THREADPRIVATE(E_gamma_star)   
218  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Vcmax       !! Energy of activation for Vcmax (J mol-1)
219!$OMP THREADPRIVATE(E_Vcmax)                                                             
220  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Jmax        !! Energy of activation for Jmax (J mol-1)
221!$OMP THREADPRIVATE(E_Jmax)
222  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: aSV           !! a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1)
223!$OMP THREADPRIVATE(aSV)   
224  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: bSV           !! b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1 °C-1)
225!$OMP THREADPRIVATE(bSV)
226  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_min   !! minimum photosynthesis temperature (deg C)
227!$OMP THREADPRIVATE(tphoto_min)
228  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_max   !! maximum photosynthesis temperature (deg C)
229!$OMP THREADPRIVATE(tphoto_max)
230  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: aSJ           !! a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1)
231!$OMP THREADPRIVATE(aSJ)   
232  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: bSJ           !! b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1 °C-1)
233!$OMP THREADPRIVATE(bSJ)   
234  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_Vcmax       !! Energy of deactivation for Vcmax (J mol-1)
235!$OMP THREADPRIVATE(D_Vcmax)                     
236  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_Jmax        !! Energy of deactivation for Jmax (J mol-1)
237!$OMP THREADPRIVATE(D_Jmax)                           
238
239  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_gm          !! Energy of activation for gm (J mol-1)
240!$OMP THREADPRIVATE(E_gm)                                       
241  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: S_gm          !! Entropy term for gm (J K-1 mol-1)
242!$OMP THREADPRIVATE(S_gm)                                       
243  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_gm          !! Energy of deactivation for gm (J mol-1)
244!$OMP THREADPRIVATE(D_gm)                                       
245         
246  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Rd          !! Energy of activation for Rd (J mol-1)
247!$OMP THREADPRIVATE(E_Rd)                                     
248  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Vcmax25       !! Maximum rate of Rubisco activity-limited carboxylation at 25°C
249                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
250!$OMP THREADPRIVATE(Vcmax25)
251  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: arJV          !! a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
252!$OMP THREADPRIVATE(arJV)
253  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: brJV          !! b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
254!$OMP THREADPRIVATE(brJV)
255  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: KmC25         !! Michaelis–Menten constant of Rubisco for CO2 at 25°C (ubar)
256!$OMP THREADPRIVATE(KmC25)                                     
257  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: KmO25         !! Michaelis–Menten constant of Rubisco for O2 at 25°C (ubar)
258!$OMP THREADPRIVATE(KmO25)               
259REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Sco25           !! Relative CO2 /O2 specificity factor for Rubisco at 25°C (bar bar-1)
260!$OMP THREADPRIVATE(Sco25)     
261  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gamma_star25  !! Ci-based CO2 compensation point in the absence of Rd at 25°C (ubar)
262!$OMP THREADPRIVATE(gamma_star25)       
263  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gm25         !! Mesophyll diffusion conductance at 25°C (mol m−2 s−1 bar−1)
264!$OMP THREADPRIVATE(gm25)     
265  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: a1            !! Empirical factor involved in the calculation of fvpd (-)
266!$OMP THREADPRIVATE(a1)                                       
267  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: b1            !! Empirical factor involved in the calculation of fvpd (-)
268!$OMP THREADPRIVATE(b1)                                       
269  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: g0            !! Residual stomatal conductance when irradiance approaches zero (mol m−2 s−1 bar−1)
270!$OMP THREADPRIVATE(g0)                                       
271  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: h_protons     !! Number of protons required to produce one ATP (mol mol-1)
272!$OMP THREADPRIVATE(h_protons)                                 
273  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fpsir         !! Fraction of PSII e− transport rate partitioned to the C4 cycle (-)
274!$OMP THREADPRIVATE(fpsir)                                         
275  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fQ            !! Fraction of electrons at reduced plastoquinone that follow the Q-cycle (-) - Values for C3 platns are not used
276!$OMP THREADPRIVATE(fQ)                                       
277  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fpseudo       !! Fraction of electrons at PSI that follow  pseudocyclic transport (-) - Values for C3 platns are not used
278!$OMP THREADPRIVATE(fpseudo)                                   
279  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kp            !! Initial carboxylation efficiency of the PEP carboxylase (mol m−2 s−1 bar−1)
280!$OMP THREADPRIVATE(kp)                                       
281  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha         !! Fraction of PSII activity in the bundle sheath (-)
282!$OMP THREADPRIVATE(alpha)                                     
283  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gbs           !! Bundle-sheath conductance (mol m−2 s−1 bar−1)
284!$OMP THREADPRIVATE(gbs)                                       
285  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: theta         !! Convexity factor for response of J to irradiance (-)
286!$OMP THREADPRIVATE(theta)                                     
287  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha_LL      !! Conversion efficiency of absorbed light into J at strictly limiting light (mol e− (mol photon)−1)
288!$OMP THREADPRIVATE(alpha_LL)
289  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: stress_vcmax  !! Stress on vcmax
290!$OMP THREADPRIVATE(stress_vcmax)
291  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: stress_gs     !! Stress on vcmax
292!$OMP THREADPRIVATE(stress_gs)
293  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: stress_gm     !! Stress on vcmax
294!$OMP THREADPRIVATE(stress_gm)
295
296  !-
297  ! 2. Stomate
298  !-
299  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff     !! extinction coefficient of the Monsi&Saeki relationship (1953)
300                                                                !! (unitless)
301!$OMP THREADPRIVATE(ext_coeff)
302  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff_vegetfrac     !! extinction coefficient used for the calculation of the
303                                                                !! bare soil fraction (unitless)
304!$OMP THREADPRIVATE(ext_coeff_vegetfrac)
305
306
307  !
308  ! ALLOCATION (stomate)
309  !
310  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: R0            !! Default root allocation (0-1, unitless)
311!$OMP THREADPRIVATE(R0)
312  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: S0            !! Default sapwood allocation (0-1, unitless)
313!$OMP THREADPRIVATE(S0)
314  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: L0            !! Default leaf allocation (0-1, unitless)
315!$OMP THREADPRIVATE(L0)
316
317
318  !
319  ! RESPIRATION (stomate)
320  !
321  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: frac_growthresp  !! fraction of GPP which is lost as growth respiration
322
323!$OMP THREADPRIVATE(frac_growthresp)
324
325  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: maint_resp_slope  !! slope of maintenance respiration coefficient
326                                                                      !! (1/K, 1/K^2, 1/K^3), used in the code
327!$OMP THREADPRIVATE(maint_resp_slope)
328
329  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_c  !! slope of maintenance respiration coefficient (1/K),
330                                                                      !! constant c of aT^2+bT+c , tabulated
331!$OMP THREADPRIVATE(maint_resp_slope_c)
332
333  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_b  !! slope of maintenance respiration coefficient (1/K),
334                                                                      !! constant b of aT^2+bT+c , tabulated
335!$OMP THREADPRIVATE(maint_resp_slope_b)
336
337  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_a  !! slope of maintenance respiration coefficient (1/K),
338                                                                      !! constant a of aT^2+bT+c , tabulated
339!$OMP THREADPRIVATE(maint_resp_slope_a)
340
341  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: coeff_maint_zero  !! maintenance respiration coefficient at 0 deg C,
342                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
343!$OMP THREADPRIVATE(coeff_maint_zero)
344
345  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_leaf        !! maintenance respiration coefficient at 0 deg C,
346                                                                      !! for leaves, tabulated
347                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
348!$OMP THREADPRIVATE(cm_zero_leaf)
349
350  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapabove    !! maintenance respiration coefficient at 0 deg C,
351                                                                      !! for sapwood above, tabulated
352                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
353!$OMP THREADPRIVATE(cm_zero_sapabove)
354
355  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapbelow    !! maintenance respiration coefficient at 0 deg C,
356                                                                      !! for sapwood below, tabulated
357                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
358!$OMP THREADPRIVATE(cm_zero_sapbelow)
359
360  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartabove  !! maintenance respiration coefficient at 0 deg C
361                                                                      !! for heartwood above, tabulated
362                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
363!$OMP THREADPRIVATE(cm_zero_heartabove)
364
365  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartbelow  !! maintenance respiration coefficient at 0 deg C,
366                                                                      !! for heartwood below, tabulated
367                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
368!$OMP THREADPRIVATE(cm_zero_heartbelow)
369
370  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_root        !! maintenance respiration coefficient at 0 deg C,
371                                                                      !! for roots, tabulated
372                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
373!$OMP THREADPRIVATE(cm_zero_root)
374
375  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_fruit       !! maintenance respiration coefficient  at 0 deg C,
376                                                                      !! for fruits, tabulated
377                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
378!$OMP THREADPRIVATE(cm_zero_fruit)
379
380  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_carbres     !! maintenance respiration coefficient at 0 deg C,
381                                                                      !! for carbohydrate reserve, tabulated
382                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
383!$OMP THREADPRIVATE(cm_zero_carbres)
384
385 
386  !
387  ! FIRE (stomate)
388  !
389  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flam              !! flamability : critical fraction of water holding
390                                                                    !! capacity (0-1, unitless)
391!$OMP THREADPRIVATE(flam)
392
393  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: resist            !! fire resistance (0-1, unitless)
394!$OMP THREADPRIVATE(resist)
395
396
397  !
398  ! FLUX - LUC (Land Use Change)
399  !
400  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_1   !! Coeff of biomass export for the year (unitless)
401!$OMP THREADPRIVATE(coeff_lcchange_1)
402
403  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_10  !! Coeff of biomass export for the decade (unitless)
404!$OMP THREADPRIVATE(coeff_lcchange_10)
405
406  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_100 !! Coeff of biomass export for the century (unitless)
407!$OMP THREADPRIVATE(coeff_lcchange_100)
408 
409 
410  !
411  ! PHENOLOGY
412  !
413  !-
414  ! 1. Stomate
415  !-
416  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max_to_happy  !! threshold of LAI below which plant uses carbohydrate reserves
417!$OMP THREADPRIVATE(lai_max_to_happy)
418
419  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max           !! maximum LAI, PFT-specific @tex $(m^2.m^{-2})$ @endtex
420!$OMP THREADPRIVATE(lai_max)
421
422  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_type     !! type of phenology (0-4, unitless)
423                                                                    !! 0=bare ground 1=evergreen,  2=summergreen,
424                                                                    !! 3=raingreen,  4=perennial
425                                                                    !! For the moment, the bare ground phenotype is not managed,
426                                                                    !! so it is considered as "evergreen"
427!$OMP THREADPRIVATE(pheno_type)
428
429  !-
430  ! 2. Leaf Onset
431  !-
432  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pheno_gdd_crit   !! critical gdd,tabulated (C), used in the code
433!$OMP THREADPRIVATE(pheno_gdd_crit)
434
435  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_c   !! critical gdd,tabulated (C),
436                                                                     !! constant c of aT^2+bT+c (unitless)
437!$OMP THREADPRIVATE(pheno_gdd_crit_c)
438
439  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_b   !! critical gdd,tabulated (C),
440                                                                     !! constant b of aT^2+bT+c (unitless)
441!$OMP THREADPRIVATE(pheno_gdd_crit_b)
442
443  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_a   !! critical gdd,tabulated (C),
444                                                                     !! constant a of aT^2+bT+c (unitless)
445!$OMP THREADPRIVATE(pheno_gdd_crit_a)
446
447  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_moigdd_t_crit!! Monthly avearage temperature treashold used for C4 grass (C)
448!$OMP THREADPRIVATE(pheno_moigdd_t_crit)
449
450  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ngd_crit           !! critical ngd,tabulated. Threshold -5 degrees (days)
451!$OMP THREADPRIVATE(ngd_crit)
452
453  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ncdgdd_temp        !! critical temperature for the ncd vs. gdd function
454                                                                     !! in phenology (C)
455!$OMP THREADPRIVATE(ncdgdd_temp)
456
457  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_frac           !! critical humidity (relative to min/max) for phenology
458                                                                     !! (0-1, unitless)
459!$OMP THREADPRIVATE(hum_frac)
460
461  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_min_time       !! minimum time elapsed since moisture minimum (days)
462!$OMP THREADPRIVATE(hum_min_time)
463
464  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_sap            !! sapwood -> heartwood conversion time (days)
465!$OMP THREADPRIVATE(tau_sap)
466
467  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_fruit          !! fruit lifetime (days)
468!$OMP THREADPRIVATE(tau_fruit)
469
470  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_leafinit  !! time to attain the initial foliage using the carbohydrate reserve
471!$OMP THREADPRIVATE(tau_leafinit)
472
473  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ecureuil           !! fraction of primary leaf and root allocation put
474                                                                     !! into reserve (0-1, unitless)
475!$OMP THREADPRIVATE(ecureuil)
476
477  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_min          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
478!$OMP THREADPRIVATE(alloc_min)
479
480  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_max          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
481!$OMP THREADPRIVATE(alloc_max)
482
483  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: demi_alloc         !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
484!$OMP THREADPRIVATE(demi_alloc)
485
486  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaflife_tab       !! leaf longevity, tabulated (??units??)
487!$OMP THREADPRIVATE(leaflife_tab)
488
489  !-
490  ! 3. Senescence
491  !-
492  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaffall              !! length of death of leaves,tabulated (days)
493!$OMP THREADPRIVATE(leaffall)
494
495  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leafagecrit           !! critical leaf age,tabulated (days)
496!$OMP THREADPRIVATE(leafagecrit)
497
498  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_type  !! type of senescence,tabulated (unitless)
499                                                                        !! List of avaible types of senescence :
500                                                                        !! 'cold  ', 'dry   ', 'mixed ', 'none  '
501!$OMP THREADPRIVATE(senescence_type)
502
503  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_hum        !! critical relative moisture availability for senescence
504                                                                        !! (0-1, unitless)
505!$OMP THREADPRIVATE(senescence_hum)
506
507  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nosenescence_hum      !! relative moisture availability above which there is
508                                                                        !! no humidity-related senescence (0-1, unitless)
509!$OMP THREADPRIVATE(nosenescence_hum)
510
511  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_turnover_time     !! maximum turnover time for grasses (days)
512!$OMP THREADPRIVATE(max_turnover_time)
513
514  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_turnover_time     !! minimum turnover time for grasses (days)
515!$OMP THREADPRIVATE(min_turnover_time)
516
517  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_leaf_age_for_senescence  !! minimum leaf age to allow senescence g (days)
518!$OMP THREADPRIVATE(min_leaf_age_for_senescence)
519
520  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: senescence_temp     !! critical temperature for senescence (C),
521                                                                        !! used in the code
522!$OMP THREADPRIVATE(senescence_temp)
523
524  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_c     !! critical temperature for senescence (C),
525                                                                        !! constant c of aT^2+bT+c , tabulated (unitless)
526!$OMP THREADPRIVATE(senescence_temp_c)
527
528  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_b     !! critical temperature for senescence (C),
529                                                                        !! constant b of aT^2+bT+c , tabulated (unitless)
530!$OMP THREADPRIVATE(senescence_temp_b)
531
532  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_a     !! critical temperature for senescence (C),
533                                                                        !! constant a of aT^2+bT+c , tabulated (unitless)
534!$OMP THREADPRIVATE(senescence_temp_a)
535
536  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gdd_senescence        !! minimum gdd to allow senescence of crops (days)
537!$OMP THREADPRIVATE(gdd_senescence)
538
539  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: always_init               !! take carbon from atmosphere if carbohydrate reserve too small? (true/false)
540!$OMP THREADPRIVATE(always_init)
541
542  !
543  ! DGVM
544  !
545
546  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: residence_time        !! residence time of trees (y)
547!$OMP THREADPRIVATE(residence_time)
548
549  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmin_crit             !! critical tmin, tabulated (C)
550!$OMP THREADPRIVATE(tmin_crit)
551
552  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tcm_crit              !! critical tcm, tabulated (C)
553!$OMP THREADPRIVATE(tcm_crit)
554
555  !
556  ! Biogenic Volatile Organic Compounds
557  !
558
559  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_isoprene       !! Isoprene emission factor
560                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
561!$OMP THREADPRIVATE(em_factor_isoprene)
562
563  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_monoterpene    !! Monoterpene emission factor
564                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
565!$OMP THREADPRIVATE(em_factor_monoterpene)
566
567  REAL(r_std), SAVE :: LDF_mono                                            !! monoterpenes fraction dependancy to light
568!$OMP THREADPRIVATE(LDF_mono)
569  REAL(r_std), SAVE :: LDF_sesq                                            !! sesquiterpenes fraction dependancy to light
570!$OMP THREADPRIVATE(LDF_sesq)
571  REAL(r_std), SAVE :: LDF_meth                                            !! methanol fraction dependancy to light
572!$OMP THREADPRIVATE(LDF_meth)
573  REAL(r_std), SAVE :: LDF_acet                                            !! acetone fraction dependancy to light
574!$OMP THREADPRIVATE(LDF_acet)
575  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_apinene        !! Alfa pinene emission factor
576                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
577!$OMP THREADPRIVATE(em_factor_apinene)
578
579  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_bpinene        !! Beta pinene emission factor
580                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
581!$OMP THREADPRIVATE(em_factor_bpinene)
582
583  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_limonene       !! Limonene emission factor
584                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
585!$OMP THREADPRIVATE(em_factor_limonene)
586
587  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_myrcene        !! Myrcene emission factor
588                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
589!$OMP THREADPRIVATE(em_factor_myrcene)
590
591  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sabinene       !! Sabinene emission factor
592                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
593!$OMP THREADPRIVATE(em_factor_sabinene)
594
595  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_camphene       !! Camphene emission factor
596                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
597!$OMP THREADPRIVATE(em_factor_camphene)
598
599  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_3carene        !! 3-carene emission factor
600                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
601!$OMP THREADPRIVATE(em_factor_3carene)
602
603  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_tbocimene      !! T-beta-ocimene emission factor
604                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
605!$OMP THREADPRIVATE(em_factor_tbocimene)
606
607  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_othermonot     !! Other monoterpenes emission factor
608                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
609!$OMP THREADPRIVATE(em_factor_othermonot)
610
611  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sesquiterp     !! Sesquiterpene emission factor
612                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
613!$OMP THREADPRIVATE(em_factor_sesquiterp)
614
615  REAL(r_std), SAVE :: beta_mono                                           !! Monoterpenes temperature dependency coefficient
616!$OMP THREADPRIVATE(beta_mono)
617  REAL(r_std), SAVE :: beta_sesq                                           !! Sesquiterpenes temperature dependency coefficient
618!$OMP THREADPRIVATE(beta_sesq)
619  REAL(r_std), SAVE :: beta_meth                                           !! Methanol temperature dependency coefficient
620!$OMP THREADPRIVATE(beta_meth)
621  REAL(r_std), SAVE :: beta_acet                                           !! Acetone temperature dependency coefficient
622!$OMP THREADPRIVATE(beta_acet)
623  REAL(r_std), SAVE :: beta_oxyVOC                                         !! Other oxygenated BVOC temperature dependency coefficient
624!$OMP THREADPRIVATE(beta_oxyVOC)
625
626  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_ORVOC          !! ORVOC emissions factor
627                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
628!$OMP THREADPRIVATE(em_factor_ORVOC)
629
630  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_OVOC           !! OVOC emissions factor
631                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
632!$OMP THREADPRIVATE(em_factor_OVOC)
633
634  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_MBO            !! MBO emissions factor
635                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
636!$OMP THREADPRIVATE(em_factor_MBO)
637
638  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_methanol       !! Methanol emissions factor
639                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
640!$OMP THREADPRIVATE(em_factor_methanol)
641
642  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetone        !! Acetone emissions factor
643                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
644!$OMP THREADPRIVATE(em_factor_acetone)
645
646  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetal         !! Acetaldehyde emissions factor
647                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
648!$OMP THREADPRIVATE(em_factor_acetal)
649
650  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formal         !! Formaldehyde emissions factor
651                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
652!$OMP THREADPRIVATE(em_factor_formal)
653
654  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetic         !! Acetic Acid emissions factor
655                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
656!$OMP THREADPRIVATE(em_factor_acetic)
657
658  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formic         !! Formic Acid emissions factor
659                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
660!$OMP THREADPRIVATE(em_factor_formic)
661
662  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_wet         !! NOx emissions factor soil emissions and
663                                                                           !! exponential dependancy factor for wet soils
664                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
665!$OMP THREADPRIVATE(em_factor_no_wet)
666
667  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_dry         !! NOx emissions factor soil emissions and
668                                                                           !! exponential dependancy factor for dry soils
669                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
670!$OMP THREADPRIVATE(em_factor_no_dry)
671
672  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Larch                    !! Larcher 1991 SAI/LAI ratio (unitless)
673!$OMP THREADPRIVATE(Larch)
674
675  !
676  ! INTERNAL PARAMETERS USED IN STOMATE_DATA
677  !
678
679  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_initmin   !! Initial lai for trees/grass
680                                                                !! @tex $(m^2.m^{-2})$ @endtex
681!$OMP THREADPRIVATE(lai_initmin)
682
683  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bm_sapl   !! sapling biomass @tex $(gC.ind^{-1})$ @endtex
684!$OMP THREADPRIVATE(bm_sapl)
685
686  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: migrate       !! migration speed @tex $(m.year^{-1})$ @endtex
687!$OMP THREADPRIVATE(migrate)
688
689  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maxdia        !! maximum stem diameter from which on crown area no longer
690                                                                !! increases (m)
691!$OMP THREADPRIVATE(maxdia)
692
693  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_sapl       !! crown of tree when sapling  @tex $(m^2$)$ @endtex
694!$OMP THREADPRIVATE(cn_sapl)
695
696  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_timecst  !! time constant for leaf age discretisation (days)
697!$OMP THREADPRIVATE(leaf_timecst)
698
699
700END MODULE pft_parameters_var
Note: See TracBrowser for help on using the repository browser.