Context Navigation

source: branches/publications/ORCHIDEE_CAN_r2290/src_stomate/stomate_data.f90 @ 7474

Last change on this file since 7474 was 2110, checked in by matthew.mcgrath, 10 years ago
DEV: Fixed bugs with writing canopy levels to histfiles
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 34.0 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_data
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF "stomate_data" module defines the values about the PFT parameters. It will print
10	!! the values of the parameters for STOMATE in the standard outputs.
11	!!
12	!!\n DESCRIPTION: None
13	!!
14	!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences
15	!! between broadleaved and coniferous forests, specifically, the assumption that grasses grow
16	!! needles is not justified. Replacing the function with the one based on Reich et al. 1997.
17	!! Given that sla=100cm2/gDW at 9 months, sla is:
18	!! sla=exp(5.615-0.46*ln(leaflon in months))
19	!!
20	!! REFERENCE(S) : None
21	!!
22	!! SVN :
23	!! $HeadURL$
24	!! $Date$
25	!! $Revision$
26	!! \n
27	!_ ================================================================================================================================
28
29	MODULE stomate_data
30
31	! modules used:
32
33	USE constantes
34	USE pft_parameters
35	USE defprec
36
37
38	IMPLICIT NONE
39
40	INTEGER(i_std),SAVE :: bavard=1 !! Level of online diagnostics in STOMATE (0-4, unitless)
41	!$OMP THREADPRIVATE(bavard)
42
43	INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index !! Move to Horizontal indices
44	!$OMP THREADPRIVATE(hori_index)
45
46	INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index !! Horizontal + PFT indices
47	!$OMP THREADPRIVATE(horipft_index)
48
49	INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horican_index !! Horizontal + canopy levels indices
50	!$OMP THREADPRIVATE(horican_index)
51
52	!
53	! Functional Allocation
54	!
55	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: latosa_height !! Slope of the relationship between k_latosa
56	!! and tree height (-)
57	!$OMP THREADPRIVATE(latosa_height)
58
59	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: latosa_ind !! Slope of the relationship between k_latosa
60	!! and stand density (-)
61	!$OMP THREADPRIVATE(latosa_ind)
62
63	!
64	! Land cover change
65	!
66	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_s_index !! Horizontal + P short indices
67	!$OMP THREADPRIVATE(horip_s_index)
68	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_m_index !! Horizontal + P medium indices
69	!$OMP THREADPRIVATE(horip_m_index)
70	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_l_index !! Horizontal + P long indice
71	!$OMP THREADPRIVATE(horip_l_index)
72	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_ss_index !! Horizontal + P short indices
73	!$OMP THREADPRIVATE(horip_ss_index)
74	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_mm_index !! Horizontal + P medium indices
75	!$OMP THREADPRIVATE(horip_mm_index)
76	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip_ll_index !! Horizontal + P long indices
77	!$OMP THREADPRIVATE(horip_ll_index)
78
79
80	INTEGER(i_std),SAVE :: itime !! time step
81	!$OMP THREADPRIVATE(itime)
82	INTEGER(i_std),SAVE :: hist_id_stomate !! STOMATE history file ID
83	!$OMP THREADPRIVATE(hist_id_stomate)
84	INTEGER(i_std),SAVE :: hist_id_stomate_IPCC !! STOMATE history file ID for IPCC output
85	!$OMP THREADPRIVATE(hist_id_stomate_IPCC)
86	INTEGER(i_std),SAVE :: rest_id_stomate !! STOMATE restart file ID
87	!$OMP THREADPRIVATE(rest_id_stomate)
88
89	REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler ) !! critical value for being adapted (1-1/e) (unitless)
90	REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler !! critical value for being regenerative (1/e) (unitless)
91
92
93	! private & public routines
94
95	PUBLIC data
96
97	CONTAINS
98
99	!! ================================================================================================================================
100	!! SUBROUTINE : data
101	!!
102	!>\BRIEF This routine defines the values of the PFT parameters. It will print the values of the parameters for STOMATE
103	!! in the standard outputs of ORCHIDEE.
104	!!
105	!! DESCRIPTION : This routine defines PFT parameters. It initializes the pheno_crit structure by tabulated parameters.\n
106	!! Some initializations are done for parameters. The SLA is calculated according to Reich et al (1992).\n
107	!! Another formulation by Reich et al(1997) could be used for the computation of the SLA.
108	!! The geographical coordinates might be used for defining some additional parameters
109	!! (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.). \n
110	!! For the moment, this possibility is not used. \n
111	!! The specifc leaf area (SLA) is calculated according Reich et al, 1992 by :
112	!! \latexonly
113	!! \input{stomate_data_SLA.tex}
114	!! \endlatexonly
115	!! The sapling (young) biomass for trees and for each compartment of biomass is calculated by :
116	!! \latexonly
117	!! \input{stomate_data_sapl_tree.tex}
118	!! \endlatexonly
119	!! The sapling biomass for grasses and for each compartment of biomass is calculated by :
120	!! \latexonly
121	!! \input{stomate_data_sapl_grass.tex}
122	!! \endlatexonly
123	!! The critical stem diameter is given by the following formula :
124	!! \latexonly
125	!! \input{stomate_data_stem_diameter.tex}
126	!! \endlatexonly
127	!!
128	!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences
129	!! between broadleaved and coniferous forests, specifically, the assumption that grasses grow
130	!! needles is not justified. Replacing the function with the one based on Reich et al. 1997.
131	!! Given that sla=100cm2/gDW at 9 months, sla is:
132	!! sla=exp(5.615-0.46*ln(leaflon in months))
133	!! \latexonly
134	!! \input{stomate_data_SLA_Reich_97.tex}
135	!! \endlatexonly
136	!!
137	!! MAIN OUTPUT VARIABLE(S):
138	!!
139	!! REFERENCE(S) :
140	!! - Reich PB, Walters MB, Ellsworth DS, (1992), Leaf life-span in relation to leaf, plant and
141	!! stand characteristics among diverse ecosystems. Ecological Monographs, Vol 62, pp 365-392.
142	!! - Reich PB, Walters MB, Ellsworth DS (1997) From tropics to tundra: global convergence in plant
143	!! functioning. Proc Natl Acad Sci USA, 94:13730 13734
144	!! - Magnani F., Mencuccini M. & Grace J. 2000. Age-related decline in stand productivity: the role of
145	!! structural acclimation under hydraulic constraints Plant, Cell and Environment 23, 251â263.
146	!! - Bloom A.J., Chapin F.S. & Mooney H.A. (1985) Resource limitation in plants. An economic analogy.
147	!! Annual Review Ecology Systematics 16, 363â392.
148	!! - Case K.E. & Fair R.C. (1989) Principles of Economics. Prentice Hall, London.
149	!! - McDowell, N., Barnard, H., Bond, B.J., Hinckley, T., Hubbard, R.M., Ishii, H., KÃ¶stner, B.,
150	!! Magnani, F. Marshall, J.D., Meinzer, F.C., Phillips, N., Ryan, M.G., Whitehead D. 2002. The
151	!! relationship between tree height and leaf area: sapwood area ratio. Oecologia, 132:12â20
152	!! - Novick, K., Oren, R., Stoy, P., Juang, F.-Y., Siqueira, M., Katul, G. 2009. The relationship between
153	!! reference canopy conductance and simplified hydraulic architecture. Advances in water resources 32,
154	!! 809-819.
155	!!
156	!! FLOWCHART :
157	!! \n
158	!_ ================================================================================================================================
159
160	SUBROUTINE data
161
162
163	!! 0. Variables and parameter declaration
164
165
166	!! 0.1 Input variables
167
168	!! 0.2 Output variables
169
170	!! 0.3 Modified variables
171
172	!! 0.4 Local variables
173
174	INTEGER(i_std) :: ier !! Check errors (unitless)
175	LOGICAL :: l_error !! Check errors (unitless)
176	INTEGER(i_std) :: j !! Index (unitless)
177	REAL(r_std) :: alpha !! alpha's : (unitless)
178	REAL(r_std) :: dia !! Stem diameter (m)
179	REAL(r_std) :: csa_sap !! Crown specific area sapling @tex $(m^2.ind^{-1})$ @endtex
180	LOGICAL(i_std),SAVE :: lfirstcall = .TRUE. !! see if this is the first call to this routine
181
182	!_ ================================================================================================================================
183
184	IF(lfirstcall)THEN
185	! this makes init errors go away for the whole routine
186	bm_sapl_old(:,icarbres,icarbon) = zero
187	lfirstcall=.FALSE.
188	ENDIF
189
190	IF ( bavard .GE. 1 ) WRITE(numout,*) 'data: PFT characteristics'
191
192	!- pheno_gdd_crit
193	pheno_gdd_crit(:,1) = pheno_gdd_crit_c(:)
194	pheno_gdd_crit(:,2) = pheno_gdd_crit_b(:)
195	pheno_gdd_crit(:,3) = pheno_gdd_crit_a(:)
196	!
197	!- senescence_temp
198	senescence_temp(:,1) = senescence_temp_c(:)
199	senescence_temp(:,2) = senescence_temp_b(:)
200	senescence_temp(:,3) = senescence_temp_a(:)
201	!
202	!- maint_resp_slope
203	maint_resp_slope(:,1) = maint_resp_slope_c(:)
204	maint_resp_slope(:,2) = maint_resp_slope_b(:)
205	maint_resp_slope(:,3) = maint_resp_slope_a(:)
206	!
207	!-coeff_maint_zero
208	coeff_maint_zero(:,ileaf) = cm_zero_leaf(:)
209	coeff_maint_zero(:,isapabove) = cm_zero_sapabove(:)
210	coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow(:)
211	coeff_maint_zero(:,iheartabove) = cm_zero_heartabove(:)
212	coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow(:)
213	coeff_maint_zero(:,iroot) = cm_zero_root(:)
214	coeff_maint_zero(:,ifruit) = cm_zero_fruit(:)
215	coeff_maint_zero(:,icarbres) = cm_zero_carbres(:)
216	coeff_maint_zero(:,ilabile) = cm_zero_labile(:)
217
218	!-Allocate parameter based variables for functional allocation
219	l_error = .FALSE.
220
221	ALLOCATE(latosa_height(nvm),stat=ier)
222	l_error = l_error .OR. (ier /= 0)
223	IF (l_error) THEN
224	WRITE(numout,*) ' Memory allocation error for latosa_height. We stop. We need nvm words = ',nvm
225	STOP 'latosa_height'
226	ENDIF
227
228	ALLOCATE(latosa_ind(nvm),stat=ier)
229	l_error = l_error .OR. (ier /= 0)
230	IF (l_error) THEN
231	WRITE(numout,*) ' Memory allocation error for latosa_ind. We stop. We need nvm words = ',nvm
232	STOP 'latosa_ind'
233	ENDIF
234
235	IF ( bavard .GE. 1 ) WRITE(numout,*) 'data: PFT characteristics'
236
237	DO j = 2,nvm ! Loop over # PFTS
238
239	IF ( bavard .GE. 1 ) WRITE(numout,'(a,i3,a,a)') ' > PFT#',j,': ', PFT_name(j)
240
241	!
242	! 1 tree? (true/false)
243	!
244	IF ( bavard .GE. 1 ) WRITE(numout,*) ' tree: (::is_tree) ', is_tree(j)
245
246	!
247	! 2 flamability (0-1, unitless)
248	!
249
250	IF ( bavard .GE. 1 ) WRITE(numout,*) ' litter flamability (::flam) :', flam(j)
251
252	!
253	! 3 fire resistance (unitless)
254	!
255
256	IF ( bavard .GE. 1 ) WRITE(numout,*) ' fire resistance (::resist) :', resist(j)
257
258	!
259	! 4 specific leaf area per mass carbon = 2 * sla / dry mass (m^2.gC^{-1})
260	!
261
262	! SZ: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous
263	! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function
264	! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is:
265	! sla=exp(5.615-0.46*ln(leaflon in months))
266
267	! Oct 2010 : sla values are prescribed by values given by N.Viovy
268
269	! includes conversion from
270	!! sla(j) = 2. * 1e-4 * EXP(5.615 - 0.46 * log(12./leaflife_tab(j)))
271	!!\latexonly
272	!!\input{stomate_data_SLA.tex}
273	!!\endlatexonly
274	! IF ( leaf_tab(j) .EQ. 2 ) THEN
275	!
276	! ! needle leaved tree
277	! sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
278	!
279	! ELSE
280	!
281	! ! broad leaved tree or grass (Reich et al 1992)
282	! sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
283	!
284	! ENDIF
285
286	!!!$ IF ( leaf_tab(j) .EQ. 1 ) THEN
287	!!!$
288	!!!$ ! broad leaved tree
289	!!!$
290	!!!$ sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
291	!!!$
292	!!!$ ELSE
293	!!!$
294	!!!$ ! needle leaved or grass (Reich et al 1992)
295	!!!$
296	!!!$ sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
297	!!!$
298	!!!$ ENDIF
299	!!!$
300	!!!$ IF ( ( leaf_tab(j) .EQ. 2 ) .AND. ( pheno_type_tab(j) .EQ. 2 ) ) THEN
301	!!!$
302	!!!$ ! summergreen needle leaf
303	!!!$
304	!!!$ sla(j) = 1.25 * sla(j)
305	!!!$
306	!!!$ ENDIF
307
308
309	!+++CHECK+++
310	! The variable name management is no longer used in sapiens_forestry - but check!
311	! Either implement a varying sla for all PFT or for none.
312	!DS! New formula for calculation for sla of PFT 6 . Should keep the imposed values of sla ?
313	! From Cafapietra 2005, average
314	!!$ IF ( (management == 4) .AND. .NOT.(is_needleleaf(j)) .AND. (is_temperate(j)) ) &
315	!!$ sla(j) = 171.5/260. * 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12.tau_leaf(j)/one_year) ) ) 1e-4
316	!!$
317	!!$ IF ( bavard .GE. 1 ) WRITE(numout,) ' specific leaf area (m2/gC) (::sla):', sla(j), 12.tau_leaf(j)/one_year
318	!+++++++++++
319
320
321	!
322	! 5 sapling characteristics
323	!
324
325	! 5.1 carbon
326
327	!calculated leaf to sapwood area ratio from hydraulic architecture or use default value
328	IF ( control%ok_functional_allocation ) THEN
329
330	IF ( is_tree(j) ) THEN
331
332	!+++NOTE+++
333	! In the final implementation KF is a function of veget which in the
334	! DOFOCO branch means it is function of light competition. The
335	! parameters below are no longer needed but were left in the code
336	! to ensure others can learn from these trials
337
338	! The ratio of leaf area to spawood area (::k_latosa) is a function of
339	! tree height (McDowell et al 2002, Novick et al. 2009). However the slope
340	! of this relationship is not well established so here we recalculate it
341	! using the tree height of a tree with a diameter of 0.5 m. k_latosa_max
342	! is based on the literature. k_latosa_min is a fixed fraction of
343	! k_latosa_max. The range of observed values is huge and are especially
344	! noisy likely due to space for time substitution. The model is exteremely
345	! sensitive to the parameter k_latosa.
346	!!$ latosa_height(j) = (k_latosa_max(j) - (k_latosa_min(j))) / &
347	!!$ (pipe_tune2(j)0.5*pipe_tune3(j))
348
349	! This implementation results in the wrong behavior: LAI starts to decrease
350	! to the point where there are not enough leaves to produce sufficient
351	! photosynthates to grow leaves. Either the observations are problematic
352	! (space for time substitution) or the model lacks a dynamic response in
353	! for example, Vcmax, k_leaf, ... It is well established that after a
354	! thinning the LAI recovers quite fast so as an alternative to the height
355	! dependency we implemented a density dependency. Note that k_latosa was
356	! made to increase with decreasing density (thus the opposite of the effect
357	! with height).
358	!!$ latosa_ind(j) = (k_latosa_max(j) - k_latosa_min(j)) / (9500 * ha_to_m2)
359
360	! This approach requires new parameters (i.e. 9500) and results in a bumpy
361	! increase in LAI. Also maximum LAI is only reached after 40 to 50 years.
362	! Neverthless adding this depency allows the leaf mass to (partly)
363	! recover.
364	!++++++++++
365
366	ELSE ! grasses
367
368	ENDIF ! Trees or grasses
369
370	! resource limitation model (stomate_alloc)
371	ELSE
372
373	IF ( is_tree(j) ) THEN
374
375	! Use parameter values as defined in constants.f90
376	alpha = alpha_tree
377
378	IF ( bavard .GE. 1 ) WRITE(numout,*) ' leaf to sapwood area ratio :', pipe_k1(j)
379
380	!! Original ORCHIDEE formulation
381	!! \latexonly
382	!! \input{stomate_data_sapl_tree.tex}
383	!! \endlatexonly
384	bm_sapl_old(j,ileaf,icarbon) = &
385	& ( ( bm_sapl_leaf(1) * pipe_tune1(j) * ( mass_ratio_heart_sap(j) * bm_sapl_leaf(2) * sla(j) / &
386	& ( pi * pipe_k1(j) ) ) bm_sapl_leaf(3) ) / sla(j) ) bm_sapl_leaf(4)
387
388
389	IF ( pheno_type(j) .NE. 1 ) THEN
390
391	! not evergreen
392	bm_sapl_old(j,icarbres,icarbon) = bm_sapl_carbres * bm_sapl_old(j,ileaf,icarbon)
393
394	ELSE
395
396	bm_sapl_old(j,icarbres,icarbon) = zero
397
398	ENDIF ! (pheno_type(j) .NE. 1 )
399
400	! Crown specific area of a sapling (crown area of an individual sapling (m^{2} ind^{-1})
401	! Given that ::bm_sapl_old is a function of ::sla, ::csa_sap will be identical across all PFTs
402	csa_sap = bm_sapl_old(j,ileaf,icarbon) / ( pipe_k1(j) / sla(j) )
403
404	! Original ORCHIDEE formulation
405	! dia = ( heartwood_sapwood * csa_sap * 4. / pi ) ** 0.5
406
407	! Alternative LPJ formulation
408	dia = ( mass_ratio_heart_sap(j) * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
409
410	! Sapwood and heartwood mass
411	bm_sapl_old(j,isapabove,icarbon) = bm_sapl_sapabove * pipe_density(j) * &
412	csa_sap * pipe_tune2(j) * dia ** pipe_tune3(j)
413	bm_sapl_old(j,isapbelow,icarbon) = bm_sapl_old(j,isapabove,icarbon)
414
415	! SZ The original LPJ version uses 0.2, not 2 as mentioned in the
416	! 1.9.5.2 version of ORCHIDEE
417	bm_sapl_old(j,iheartabove,icarbon) = bm_sapl_heartabove * bm_sapl_old(j,isapabove,icarbon)
418	bm_sapl_old(j,iheartbelow,icarbon) = bm_sapl_heartbelow * bm_sapl_old(j,isapbelow,icarbon)
419
420	ELSE ! grasses
421
422	!!\latexonly
423	!!\input{stomate_data_sapl_grass.tex}
424	!!\endlatexonly
425
426	alpha = alpha_grass
427
428	IF ( natural(j) ) THEN
429
430	bm_sapl_old(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
431
432	ELSE
433
434	bm_sapl_old(j,ileaf,icarbon) = init_sapl_mass_leaf_agri / sla(j)
435
436	ENDIF
437
438	bm_sapl_old(j,icarbres,icarbon) = init_sapl_mass_carbres * bm_sapl_old(j,ileaf,icarbon)
439
440	bm_sapl_old(j,isapabove,icarbon) = zero
441	bm_sapl_old(j,isapbelow,icarbon) = zero
442
443	bm_sapl_old(j,iheartabove,icarbon) = zero
444	bm_sapl_old(j,iheartbelow,icarbon) = zero
445
446	ENDIF !Trees or grasses
447
448	! SZ The original LPJ version uses 1*ltor_max
449	bm_sapl_old(j,iroot,icarbon) = init_sapl_mass_root * (1./alpha) * bm_sapl_old(j,ileaf,icarbon)
450	bm_sapl_old(j,ifruit,icarbon) = init_sapl_mass_fruit * bm_sapl_old(j,ileaf,icarbon)
451	bm_sapl_old(j,ilabile,icarbon) = zero
452
453	!+++OCN+++
454	! bm_sapl_old(j,ilabile,icarbon) = 0.1
455	!+++++++++
456
457	IF ( bavard .GE. 1 ) THEN
458	WRITE(numout,*) ' sapling biomass (gC):'
459	WRITE(numout,*) ' leaves: (::bm_sapl_old(j,ileaf,icarbon))',bm_sapl_old(j,ileaf,icarbon)
460	WRITE(numout,*) ' sap above ground: (::bm_sapl_old(j,ispabove,icarbon)):',&
461	bm_sapl_old(j,isapabove,icarbon)
462	WRITE(numout,*) ' sap below ground: (::bm_sapl_old(j,isapbelow,icarbon))',&
463	bm_sapl_old(j,isapbelow,icarbon)
464	WRITE(numout,*) ' heartwood above ground: (::bm_sapl_old(j,iheartabove,icarbon))',&
465	bm_sapl_old(j,iheartabove,icarbon)
466	WRITE(numout,*) ' heartwood below ground: (::bm_sapl_old(j,iheartbelow,icarbon))',&
467	bm_sapl_old(j,iheartbelow,icarbon)
468	WRITE(numout,*) ' roots: (::bm_sapl_old(j,iroot,icarbon))',bm_sapl_old(j,iroot,icarbon)
469	WRITE(numout,*) ' fruits: (::bm_sapl_old(j,ifruit,icarbon))',bm_sapl_old(j,ifruit,icarbon)
470	WRITE(numout,*) ' carbohydrate reserve: (::bm_sapl_old(j,icarbres,icarbon))',&
471	bm_sapl_old(j,icarbres,icarbon)
472	WRITE(numout,*) ' labile reserve: (::bm_sapl_old(j,ilabile,icarbon))',bm_sapl_old(j,ilabile,icarbon)
473	ENDIF !( bavard .GE. 1 )
474
475	ENDIF !control%ok_functional_allocation
476
477
478
479
480	!
481	! 6 migration speed (m/year)
482	!
483
484	IF ( is_tree(j) ) THEN
485
486	migrate(j) = migrate_tree
487
488	ELSE
489
490	! can be any value as grasses are, per definition, everywhere (big leaf).
491	migrate(j) = migrate_grass
492
493	ENDIF !( is_tree(j) )
494
495	IF ( bavard .GE. 1 ) WRITE(numout,*) ' migration speed (m/year): (::migrate(j))', migrate(j)
496
497	!
498	! 7 critical stem diameter: beyond this diameter, the crown area no longer
499	! increases (m)
500	!
501
502	IF ( is_tree(j) ) THEN
503
504	!!\latexonly
505	!!\input{stomate_data_stem_diameter.tex}
506	!!\endlatexonly
507
508	maxdia(j) = ( ( pipe_tune4(j) / ((pipe_tune2(j)pipe_tune3(j))/(maxdia_coeff(1)*pipe_tune3(j))) ) &
509	** ( un / ( pipe_tune3(j) - un ) ) ) * maxdia_coeff(2)
510	!not in OCN
511	!cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
512
513	ELSE
514
515	maxdia(j) = undef
516	!not in OCN
517	!cn_sapl(j)=1
518
519	ENDIF !( is_tree(j) )
520
521	IF ( bavard .GE. 1 ) WRITE(numout,*) ' critical stem diameter (m): (::maxdia(j))', maxdia(j)
522
523	!
524	! 8 Coldest tolerable temperature (K)
525	!
526
527	IF ( ABS( tmin_crit(j) - undef ) .GT. min_stomate ) THEN
528	tmin_crit(j) = tmin_crit(j) + ZeroCelsius
529	ELSE
530	tmin_crit(j) = undef
531	ENDIF
532
533	IF ( bavard .GE. 1 ) &
534	WRITE(numout,*) ' coldest tolerable temperature (K): (::tmin_crit(j))', tmin_crit(j)
535
536	!
537	! 9 Maximum temperature of the coldest month: need to be below this temperature
538	! for a certain time to regrow leaves next spring (vernalization) (K)
539	!
540
541	IF ( ABS ( tcm_crit(j) - undef ) .GT. min_stomate ) THEN
542	tcm_crit(j) = tcm_crit(j) + ZeroCelsius
543	ELSE
544	tcm_crit(j) = undef
545	ENDIF
546
547	IF ( bavard .GE. 1 ) &
548	WRITE(numout,*) ' vernalization temperature (K): (::tcm_crit(j))', tcm_crit(j)
549
550	!
551	! 10 critical values for phenology
552	!
553
554	! 10.1 model used
555
556	IF ( bavard .GE. 1 ) &
557	WRITE(numout,*) ' phenology model used: (::pheno_model(j)) ',pheno_model(j)
558
559	! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C
560	! or whatever), depends on how this is used in stomate_phenology.
561
562
563	IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) ) THEN
564	WRITE(numout,*) ' critical GDD is a function of long term T (C): (::gdd)'
565	WRITE(numout,*) ' ',pheno_gdd_crit(j,1), &
566	' + T *',pheno_gdd_crit(j,2), &
567	' + T^2 *',pheno_gdd_crit(j,3)
568	ENDIF
569
570	! consistency check
571
572	IF ( ( ( pheno_model(j) .EQ. 'moigdd' ) .OR. &
573	( pheno_model(j) .EQ. 'humgdd' ) ) .AND. &
574	( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) ) THEN
575	STOP 'problem with phenology parameters, critical GDD. (::pheno_model)'
576	ENDIF
577
578	! 10.3 number of growing days
579
580	IF ( ( bavard .GE. 1 ) .AND. ( ngd_crit(j) .NE. undef ) ) &
581	WRITE(numout,*) ' critical NGD: (::ngd_crit(j))', ngd_crit(j)
582
583	! 10.4 critical temperature for ncd vs. gdd function in phenology (C)
584
585	IF ( ( bavard .GE. 1 ) .AND. ( ncdgdd_temp(j) .NE. undef ) ) &
586	WRITE(numout,*) ' critical temperature for NCD vs. GDD (C): (::ncdgdd_temp(j))', &
587	ncdgdd_temp(j)
588
589	! 10.5 humidity fractions (0-1, unitless)
590
591	IF ( ( bavard .GE. 1 ) .AND. ( hum_frac(j) .NE. undef ) ) &
592	WRITE(numout,*) ' critical humidity fraction: (::hum_frac(j))', &
593	& hum_frac(j)
594
595
596	! 10.6 minimum time elapsed since moisture minimum (days)
597
598	IF ( ( bavard .GE. 1 ) .AND. ( hum_min_time(j) .NE. undef ) ) &
599	WRITE(numout,*) ' time to wait after moisture min (d): (::hum_min_time(j))', &
600	& hum_min_time(j)
601
602	!
603	! 11 critical values for senescence
604	!
605
606	! 11.1 type of senescence
607
608	IF ( bavard .GE. 1 ) &
609	WRITE(numout,*) ' type of senescence: (::senescence_type(j))',senescence_type(j)
610
611	! 11.2 critical temperature for senescence (C)
612
613	IF ( ( bavard .GE. 1 ) .AND. ( ALL(senescence_temp(j,:) .NE. undef) ) ) THEN
614	WRITE(numout,*) ' critical temperature for senescence (C) is'
615	WRITE(numout,*) ' a function of long term T (C): (::senescence_temp)'
616	WRITE(numout,*) ' ',senescence_temp(j,1), &
617	' + T *',senescence_temp(j,2), &
618	' + T^2 *',senescence_temp(j,3)
619	ENDIF
620
621	! consistency check
622
623	IF ( ( ( senescence_type(j) .EQ. 'cold' ) .OR. &
624	( senescence_type(j) .EQ. 'mixed' ) ) .AND. &
625	( ANY(senescence_temp(j,:) .EQ. undef ) ) ) THEN
626	STOP 'problem with senescence parameters, temperature. (::senescence_type)'
627	ENDIF
628
629	! 11.3 critical relative moisture availability for senescence
630
631	IF ( ( bavard .GE. 1 ) .AND. ( senescence_hum(j) .NE. undef ) ) &
632	WRITE(numout,*) ' max. critical relative moisture availability for'
633	WRITE(numout,*) ' senescence: (::senescence_hum(j))', &
634	& senescence_hum(j)
635
636	! consistency check
637
638	IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
639	( senescence_type(j) .EQ. 'mixed' ) ) .AND. &
640	( senescence_hum(j) .EQ. undef ) ) THEN
641	STOP 'problem with senescence parameters, humidity.(::senescence_type)'
642	ENDIF
643
644	! 14.3 relative moisture availability above which there is no moisture-related
645	! senescence (0-1, unitless)
646
647	IF ( ( bavard .GE. 1 ) .AND. ( nosenescence_hum(j) .NE. undef ) ) &
648	WRITE(numout,*) ' relative moisture availability above which there is'
649	WRITE(numout,*) ' no moisture-related senescence: (::nosenescence_hum(j))', &
650	& nosenescence_hum(j)
651
652	! consistency check
653
654	IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
655	( senescence_type(j) .EQ. 'mixed' ) ) .AND. &
656	( nosenescence_hum(j) .EQ. undef ) ) THEN
657	STOP 'problem with senescence parameters, humidity. (::senescence_type)'
658	ENDIF
659
660	!
661	! 12 sapwood -> heartwood conversion time (days)
662	!
663
664	IF ( bavard .GE. 1 ) &
665	WRITE(numout,*) ' sapwood -> heartwood conversion time (d): (::tau_sap(j))', tau_sap(j)
666
667	!
668	! 13 fruit lifetime (days)
669	!
670
671	IF ( bavard .GE. 1 ) WRITE(numout,*) ' fruit lifetime (d): (::tau_fruit(j))', tau_fruit(j)
672
673	!
674	! 14 length of leaf death (days)
675	! For evergreen trees, this variable determines the lifetime of the leaves.
676	! Note that it is different from the value given in tau_leaf.
677	!
678
679	IF ( bavard .GE. 1 ) &
680	WRITE(numout,*) ' length of leaf death (d): (::leaffall(j))', leaffall(j)
681
682	!
683	! 15 maximum lifetime of leaves (days)
684	!
685
686	IF ( ( bavard .GE. 1 ) .AND. ( tau_leaf(j) .NE. undef ) ) &
687	WRITE(numout,*) ' critical leaf age (d): (::tau_leaf(j))', tau_leaf(j)
688
689	!
690	! 16 time constant for leaf age discretisation (days)
691	!
692
693	leaf_timecst(j) = tau_leaf(j) / REAL( nleafages,r_std )
694
695	IF ( bavard .GE. 1 ) &
696	WRITE(numout,*) ' time constant for leaf age discretisation (d): (::leaf_timecst(j))', &
697	leaf_timecst(j)
698
699	!
700	! 17 minimum lai, initial (m^2.m^{-2})
701	!
702
703	IF ( is_tree(j) ) THEN
704	lai_initmin(j) = lai_initmin_tree
705	ELSE
706	lai_initmin(j) = lai_initmin_grass
707	ENDIF !( is_tree(j) )
708
709	IF ( bavard .GE. 1 ) &
710	WRITE(numout,*) ' initial LAI: (::lai_initmin(j))', lai_initmin(j)
711
712	!
713	! 19 maximum LAI (m^2.m^{-2})
714	!
715
716	IF ( bavard .GE. 1 ) &
717	WRITE(numout,*) ' critical LAI above which no leaf allocation: (::lai_max(j))', lai_max(j)
718
719	!
720	! 20 fraction of primary leaf and root allocation put into reserve (0-1, unitless)
721	!
722
723	IF ( bavard .GE. 1 ) &
724	WRITE(numout,*) ' reserve allocation factor: (::ecureuil(j))', ecureuil(j)
725
726	!
727	! 21 maintenance respiration coefficient (g/g/day) at 0 deg C
728	!
729
730
731	IF ( bavard .GE. 1 ) THEN
732
733	WRITE(numout,*) ' maintenance respiration coefficient (g/g/day) at 0 deg C:'
734	WRITE(numout,*) ' . leaves: (::coeff_maint_zero(j,ileaf))',coeff_maint_zero(j,ileaf)
735	WRITE(numout,*) ' . sapwood above ground: (::coeff_maint_zero(j,isapabove)) ',&
736	& coeff_maint_zero(j,isapabove)
737	WRITE(numout,*) ' . sapwood below ground: (::coeff_maint_zero(j,isapbelow)) ',&
738	& coeff_maint_zero(j,isapbelow)
739	WRITE(numout,*) ' . heartwood above ground: (::coeff_maint_zero(j,iheartabove)) ',&
740	& coeff_maint_zero(j,iheartabove)
741	WRITE(numout,*) ' . heartwood below ground: (::coeff_maint_zero(j,iheartbelow)) ',&
742	& coeff_maint_zero(j,iheartbelow)
743	WRITE(numout,*) ' . roots: (::coeff_maint_zero(j,iroot))',coeff_maint_zero(j,iroot)
744	WRITE(numout,*) ' . fruits: (::coeff_maint_zero(j,ifruit)) ',coeff_maint_zero(j,ifruit)
745	WRITE(numout,*) ' . carbohydrate reserve: (::coeff_maint_zero(j,icarbres)) ',&
746	& coeff_maint_zero(j,icarbres)
747	WRITE(numout,*) ' . labile pool (::coeff_maint_zero(j,ilabile)) ', &
748	& coeff_maint_zero(j,ilabile)
749
750
751	ENDIF !( bavard .GE. 1 )
752
753	!
754	! 22 parameter for temperature sensitivity of maintenance respiration
755	!
756
757	IF ( bavard .GE. 1 ) &
758	WRITE(numout,*) ' temperature sensitivity of maintenance respiration (1/K) is'
759	WRITE(numout,*) ' a function of long term T (C): (::maint_resp_slope)'
760	WRITE(numout,) ' ',maint_resp_slope(j,1),' + T ',maint_resp_slope(j,2), &
761	' + T^2 *',maint_resp_slope(j,3)
762
763	!
764	! 23 natural ?
765	!
766
767	IF ( bavard .GE. 1 ) &
768	WRITE(numout,*) ' Natural: (::natural(j))', natural(j)
769
770	!
771	! 24 Vcmax (umol.m^{-2}.s^{-1})
772	!
773
774	IF ( bavard .GE. 1 ) &
775	WRITE(numout,*) ' Maximum rate of carboxylation:(::Vcmax25(j))', Vcmax25(j)
776
777
778	!
779	! 25 constants for photosynthesis temperatures
780	!
781
782
783	IF ( bavard .GE. 1 ) THEN
784	WRITE(numout,*) ' min. temperature for photosynthesis as a function of long term T (C):'
785	WRITE(numout,*) ' (::tphoto_min_c(j))'
786	WRITE(numout,*) ' ',tphoto_min_c(j), &
787	' + T*',tphoto_min_b(j), &
788	' + T^2*',tphoto_min_a(j)
789	WRITE(numout,*) ' opt. temperature for photosynthesis as a function of long term T (C):'
790	WRITE(numout,*) ' (::tphoto_opt_c(j))'
791	WRITE(numout,*) ' ',tphoto_opt_c(j), &
792	' + T*',tphoto_opt_b(j), &
793	' + T^2*',tphoto_opt_a(j)
794	WRITE(numout,*) ' max. temperature for photosynthesis as a function of long term T (C):'
795	WRITE(numout,*)' (::tphoto_max_c(j))'
796	WRITE(numout,*) ' ',tphoto_max_c(j), &
797	' + T*',tphoto_max_b(j), &
798	' + T^2*',tphoto_max_a(j)
799
800
801	!
802	! 26 Properties
803	!
804
805	WRITE(numout,*) ' C4 photosynthesis: (::is_c4(j))', is_c4(j)
806	WRITE(numout,*) ' Depth constant for root profile (m): (::1./humcste(j))', 1./humcste(j)
807
808	ENDIF !( bavard .GE. 1 )
809
810	!
811	! 27 extinction coefficient of the Monsi and Saeki (1953) relationship
812	!
813	IF ( bavard .GE. 1 ) THEN
814	WRITE(numout,*) ' extinction coefficient: (::ext_coeff(j))', ext_coeff(j)
815	ENDIF !( bavard .GE. 1 )
816
817	ENDDO ! Loop over # PFTS
818
819	!
820	! 29 time scales for phenology and other processes (in days)
821	!
822
823	tau_longterm = coeff_tau_longterm * one_year
824
825	IF ( bavard .GE. 1 ) THEN
826
827	WRITE(numout,*) ' > time scale for ''monthly'' moisture availability (d): (::tau_hum_month)', &
828	tau_hum_month
829	WRITE(numout,*) ' > time scale for ''weekly'' moisture availability (d): (::tau_hum_week)', &
830	tau_hum_week
831	WRITE(numout,*) ' > time scale for ''monthly'' 2 meter temperature (d): (::tau_t2m_month)', &
832	tau_t2m_month
833	WRITE(numout,*) ' > time scale for ''weekly'' 2 meter temperature (d): (::tau_t2m_week)', &
834	tau_t2m_week
835	WRITE(numout,*) ' > time scale for ''weekly'' GPP (d): (::tau_gpp_week)', &
836	tau_gpp_week
837	WRITE(numout,*) ' > time scale for ''monthly'' soil temperature (d): (::tau_tsoil_month)', &
838	tau_tsoil_month
839	WRITE(numout,*) ' > time scale for ''monthly'' soil humidity (d): (::tau_soilhum_month)', &
840	tau_soilhum_month
841	WRITE(numout,*) ' > time scale for vigour calculations (y): (::tau_longterm / one_year)', &
842	tau_longterm / one_year
843
844	ENDIF !( bavard .GE. 1 )
845
846	!
847	! 30 fraction of allocatable biomass which is lost as growth respiration (0-1, unitless)
848	!
849
850	IF ( bavard .GE. 1 ) &
851	WRITE(numout,*) ' > growth respiration fraction: (::frac_growthresp)', frac_growthresp
852
853	IF (bavard.GE.4) WRITE(numout,*) 'Leaving data'
854
855	END SUBROUTINE data
856
857	END MODULE stomate_data

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

Download in other formats: