Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

stomate_data.f90 @ 6737

Last change on this file since 6737 was 5275, checked in by chao.yue, 6 years ago
Make the adjustment of bm_sapl only effective for gluc
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 26.9 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_data
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.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 time, ONLY : one_day, dt_sechiba, one_year
34	USE pft_parameters
35	USE defprec
36
37
38	IMPLICIT NONE
39
40	INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index !! Move to Horizontal indices
41	!$OMP THREADPRIVATE(hori_index)
42
43	INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index !! Horizontal + PFT indices
44	!$OMP THREADPRIVATE(horipft_index)
45
46	! Land cover change
47
48	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip10_index !! Horizontal + P10 indices
49	!$OMP THREADPRIVATE(horip10_index)
50	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip100_index !! Horizontal + P100 indice
51	!$OMP THREADPRIVATE(horip100_index)
52	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip11_index !! Horizontal + P11 indices
53	!$OMP THREADPRIVATE(horip11_index)
54	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip101_index !! Horizontal + P101 indices
55	!$OMP THREADPRIVATE(horip101_index)
56	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horideep_index
57	!$OMP THREADPRIVATE(horideep_index)
58	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horisnow_index
59	!$OMP THREADPRIVATE(horisnow_index)
60	INTEGER(i_std),SAVE :: itime !! time step
61	!$OMP THREADPRIVATE(itime)
62	INTEGER(i_std),SAVE :: hist_id_stomate !! STOMATE history file ID
63	!$OMP THREADPRIVATE(hist_id_stomate)
64	INTEGER(i_std),SAVE :: hist_id_stomate_IPCC !! STOMATE history file ID for IPCC output
65	!$OMP THREADPRIVATE(hist_id_stomate_IPCC)
66	INTEGER(i_std),SAVE :: rest_id_stomate !! STOMATE restart file ID
67	!$OMP THREADPRIVATE(rest_id_stomate)
68
69	REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler ) !! critical value for being adapted (1-1/e) (unitless)
70	REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler !! critical value for being regenerative (1/e) (unitless)
71
72
73	! private & public routines
74
75	PUBLIC data
76
77	CONTAINS
78
79	!! ================================================================================================================================
80	!! SUBROUTINE : data
81	!!
82	!>\BRIEF This routine defines the values of the PFT parameters. It will print the values of the parameters for STOMATE
83	!! in the standard outputs of ORCHIDEE.
84	!!
85	!! DESCRIPTION : This routine defines PFT parameters. It initializes the pheno_crit structure by tabulated parameters.\n
86	!! Some initializations are done for parameters. The SLA is calculated according to Reich et al (1992).\n
87	!! Another formulation by Reich et al(1997) could be used for the computation of the SLA.
88	!! The geographical coordinates might be used for defining some additional parameters
89	!! (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.). \n
90	!! For the moment, this possibility is not used. \n
91	!! The specifc leaf area (SLA) is calculated according Reich et al, 1992 by :
92	!! \latexonly
93	!! \input{stomate_data_SLA.tex}
94	!! \endlatexonly
95	!! The sapling (young) biomass for trees and for each compartment of biomass is calculated by :
96	!! \latexonly
97	!! \input{stomate_data_sapl_tree.tex}
98	!! \endlatexonly
99	!! The sapling biomass for grasses and for each compartment of biomass is calculated by :
100	!! \latexonly
101	!! \input{stomate_data_sapl_grass.tex}
102	!! \endlatexonly
103	!! The critical stem diameter is given by the following formula :
104	!! \latexonly
105	!! \input{stomate_data_stem_diameter.tex}
106	!! \endlatexonly
107	!!
108	!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences
109	!! between broadleaved and coniferous forests, specifically, the assumption that grasses grow
110	!! needles is not justified. Replacing the function with the one based on Reich et al. 1997.
111	!! Given that sla=100cm2/gDW at 9 months, sla is:
112	!! sla=exp(5.615-0.46*ln(leaflon in months))
113	!! \latexonly
114	!! \input{stomate_data_SLA_Reich_97.tex}
115	!! \endlatexonly
116	!!
117	!! MAIN OUTPUT VARIABLE(S):
118	!!
119	!! REFERENCE(S) :
120	!! - Reich PB, Walters MB, Ellsworth DS, (1992), Leaf life-span in relation to leaf, plant and
121	!! stand characteristics among diverse ecosystems. Ecological Monographs, Vol 62, pp 365-392.
122	!! - Reich PB, Walters MB, Ellsworth DS (1997) From tropics to tundra: global convergence in plant
123	!! functioning. Proc Natl Acad Sci USA, 94:13730 13734
124	!!
125	!! FLOWCHART :
126	!! \n
127	!_ ================================================================================================================================
128
129	SUBROUTINE data (npts, lalo)
130
131
132	!! 0. Variables and parameter declaration
133
134
135	!! 0.1 Input variables
136
137	INTEGER(i_std), INTENT(in) :: npts !! [DISPENSABLE] Domain size (unitless)
138	REAL(r_std),DIMENSION (npts,2), INTENT (in) :: lalo !! [DISPENSABLE] Geographical coordinates (latitude,longitude)
139
140	!! 0.4 Local variables
141
142	INTEGER(i_std) :: j !! Index (unitless)
143	REAL(r_std) :: alpha !! alpha's : (unitless)
144	REAL(r_std) :: dia !! stem diameter (m)
145	REAL(r_std) :: csa_sap !! Crown specific area sapling @tex $(m^2.ind^{-1})$ @endtex
146
147	!_ ================================================================================================================================
148
149	!- pheno_gdd_crit
150	pheno_gdd_crit(:,1) = pheno_gdd_crit_c(:)
151	pheno_gdd_crit(:,2) = pheno_gdd_crit_b(:)
152	pheno_gdd_crit(:,3) = pheno_gdd_crit_a(:)
153	!
154	!- senescence_temp
155	senescence_temp(:,1) = senescence_temp_c(:)
156	senescence_temp(:,2) = senescence_temp_b(:)
157	senescence_temp(:,3) = senescence_temp_a(:)
158	!
159	!- maint_resp_slope
160	maint_resp_slope(:,1) = maint_resp_slope_c(:)
161	maint_resp_slope(:,2) = maint_resp_slope_b(:)
162	maint_resp_slope(:,3) = maint_resp_slope_a(:)
163	!
164	!-coeff_maint_zero
165	coeff_maint_zero(:,ileaf) = cm_zero_leaf(:)
166	coeff_maint_zero(:,isapabove) = cm_zero_sapabove(:)
167	coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow(:)
168	coeff_maint_zero(:,iheartabove) = cm_zero_heartabove(:)
169	coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow(:)
170	coeff_maint_zero(:,iroot) = cm_zero_root(:)
171	coeff_maint_zero(:,ifruit) = cm_zero_fruit(:)
172	coeff_maint_zero(:,icarbres) = cm_zero_carbres(:)
173
174
175	IF ( printlev >= 2 ) WRITE(numout,*) 'data: PFT characteristics'
176
177	DO j = 2,nvm ! Loop over # PFTS
178
179	IF ( printlev >= 2 ) WRITE(numout,'(a,i3,a,a)') ' > PFT#',j,': ', PFT_name(j)
180
181	!
182	! 1 tree? (true/false)
183	!
184	IF ( printlev >= 2 ) WRITE(numout,*) ' tree: (::is_tree) ', is_tree(j)
185
186	!
187	! 2 flamability (0-1, unitless)
188	!
189
190	IF ( printlev >= 2 ) WRITE(numout,*) ' litter flamability (::flam) :', flam(j)
191
192	!
193	! 3 fire resistance (unitless)
194	!
195
196	IF ( printlev >= 2 ) WRITE(numout,*) ' fire resistance (::resist) :', resist(j)
197
198	!
199	! 4 specific leaf area per mass carbon = 2 * sla / dry mass (m^2.gC^{-1})
200	!
201
202	! S. Zaehle: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous
203	! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function
204	! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is:
205	! sla=exp(5.615-0.46*ln(leaflon in months))
206
207	! Oct 2010 : sla values are prescribed by values given by N.Viovy
208
209	! includes conversion from
210	!! sla(j) = 2. * 1e-4 * EXP(5.615 - 0.46 * log(12./leaflife_tab(j)))
211	!!\latexonly
212	!!\input{stomate_data_SLA.tex}
213	!!\endlatexonly
214	! IF ( leaf_tab(j) .EQ. 2 ) THEN
215	!
216	! ! needle leaved tree
217	! sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
218	!
219	! ELSE
220	!
221	! ! broad leaved tree or grass (Reich et al 1992)
222	! sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
223	!
224	! ENDIF
225
226	!!!$ IF ( leaf_tab(j) .EQ. 1 ) THEN
227	!!!$
228	!!!$ ! broad leaved tree
229	!!!$
230	!!!$ sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
231	!!!$
232	!!!$ ELSE
233	!!!$
234	!!!$ ! needle leaved or grass (Reich et al 1992)
235	!!!$
236	!!!$ sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
237	!!!$
238	!!!$ ENDIF
239	!!!$
240	!!!$ IF ( ( leaf_tab(j) .EQ. 2 ) .AND. ( pheno_type_tab(j) .EQ. 2 ) ) THEN
241	!!!$
242	!!!$ ! summergreen needle leaf
243	!!!$
244	!!!$ sla(j) = 1.25 * sla(j)
245	!!!$
246	!!!$ ENDIF
247
248	IF ( printlev >= 2 ) WRITE(numout,) ' specific leaf area (m*2/gC) (::sla):', sla(j), 12./leaflife_tab(j)
249
250	!
251	! 5 sapling characteristics
252	!
253
254	IF ( is_tree(j) ) THEN
255
256	!> 5.1 trees
257
258	!!\latexonly
259	!!\input{stomate_data_sapl_tree.tex}
260	!!\endlatexonly
261
262	alpha = alpha_tree
263
264	bm_sapl(j,ileaf,icarbon) = &
265	& ((bm_sapl_leaf(1)pipe_tune1(mass_ratio_heart_sap bm_sapl_leaf(2)sla(j)/(pi*pipe_k1)) &
266	& bm_sapl_leaf(3))/sla(j))bm_sapl_leaf(4)
267
268	IF ( pheno_type(j) .NE. 1 ) THEN
269	! not evergreen
270	bm_sapl(j,icarbres,icarbon) = bm_sapl_carbres * bm_sapl(j,ileaf,icarbon)
271	ELSE
272	bm_sapl(j,icarbres,icarbon) = zero
273	ENDIF ! (pheno_type_tab(j) .NE. 1 )
274
275	csa_sap = bm_sapl(j,ileaf,icarbon) / ( pipe_k1 / sla(j) )
276
277	dia = (mass_ratio_heart_sap * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
278
279	bm_sapl(j,isapabove,icarbon) = &
280	bm_sapl_sapabove * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3
281	bm_sapl(j,isapbelow,icarbon) = bm_sapl(j,isapabove,icarbon)
282
283	bm_sapl(j,iheartabove,icarbon) = bm_sapl_heartabove * bm_sapl(j,isapabove,icarbon)
284	bm_sapl(j,iheartbelow,icarbon) = bm_sapl_heartbelow * bm_sapl(j,isapbelow,icarbon)
285
286	ELSE
287
288	!> 5.2 grasses
289
290	!!\latexonly
291	!!\input{stomate_data_sapl_grass.tex}
292	!!\endlatexonly
293
294	alpha = alpha_grass
295
296	IF (ok_LAIdev(j)) THEN
297	IF ( natural(j) ) THEN
298	WRITE(numout,*) 'both ok_LAIdev and natural in ', j, ', configuration error'
299	!bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
300	bm_sapl(j,ileaf,icarbon) = 0
301	CALL ipslerr_p(3, 'data','configuration error','both ok_LAIdev and natural in some PFT(s)','')
302	ELSE
303	bm_sapl(j,ileaf,icarbon) = zero
304	!we do not need initial biomass to start growth in STICS
305	ENDIF
306	! this could be a bug, if planting density is too high
307	bm_sapl(j,icarbres,icarbon) = SP_densitesem(j)*SP_pgrainmaxi(j)
308	!bm_sapl(j,icarbres,icarbon) = zero
309	ELSE
310	IF ( natural(j) .OR. is_grassland_manag(j) ) THEN
311	bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
312	ELSE
313	bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_agri / sla(j)
314	ENDIF
315
316	bm_sapl(j,icarbres,icarbon) = init_sapl_mass_carbres *bm_sapl(j,ileaf,icarbon)
317	ENDIF
318
319	bm_sapl(j,isapabove,icarbon) = zero
320	bm_sapl(j,isapbelow,icarbon) = zero
321
322	bm_sapl(j,iheartabove,icarbon) = zero
323	bm_sapl(j,iheartbelow,icarbon) = zero
324
325	ENDIF !( is_tree(j) )
326
327	bm_sapl(j,iroot,icarbon) = init_sapl_mass_root * (1./alpha) * bm_sapl(j,ileaf,icarbon)
328
329	bm_sapl(j,ifruit,icarbon) = init_sapl_mass_fruit * bm_sapl(j,ileaf,icarbon)
330
331	IF (.NOT. ok_dgvm .AND. use_age_class) THEN
332	bm_sapl(j,:,icarbon) = bm_sapl(j,:,icarbon) * 0.05
333	ENDIF
334
335	IF ( printlev >= 2 ) THEN
336	WRITE(numout,*) ' sapling biomass (gC):'
337	WRITE(numout,*) ' leaves: (::bm_sapl(j,ileaf,icarbon))',bm_sapl(j,ileaf,icarbon)
338	WRITE(numout,*) ' sap above ground: (::bm_sapl(j,ispabove,icarbon)):',bm_sapl(j,isapabove,icarbon)
339	WRITE(numout,*) ' sap below ground: (::bm_sapl(j,isapbelow,icarbon))',bm_sapl(j,isapbelow,icarbon)
340	WRITE(numout,*) ' heartwood above ground: (::bm_sapl(j,iheartabove,icarbon))',bm_sapl(j,iheartabove,icarbon)
341	WRITE(numout,*) ' heartwood below ground: (::bm_sapl(j,iheartbelow,icarbon))',bm_sapl(j,iheartbelow,icarbon)
342	WRITE(numout,*) ' roots: (::bm_sapl(j,iroot,icarbon))',bm_sapl(j,iroot,icarbon)
343	WRITE(numout,*) ' fruits: (::bm_sapl(j,ifruit,icarbon))',bm_sapl(j,ifruit,icarbon)
344	WRITE(numout,*) ' carbohydrate reserve: (::bm_sapl(j,icarbres,icarbon))',bm_sapl(j,icarbres,icarbon)
345	WRITE(numout,*) ' Total sapling biomss:',SUM(bm_sapl(j,:,icarbon))
346	ENDIF
347
348	!
349	! 6 migration speed (m/year)
350	!
351
352	IF ( is_tree(j) ) THEN
353
354	migrate(j) = migrate_tree
355
356	ELSE
357
358	! can be any value as grasses are, per definition, everywhere (big leaf).
359	migrate(j) = migrate_grass
360
361	ENDIF !( is_tree(j) )
362
363	IF ( printlev >= 2 ) WRITE(numout,*) ' migration speed (m/year): (::migrate(j))', migrate(j)
364
365	!
366	! 7 critical stem diameter: beyond this diameter, the crown area no longer
367	! increases (m)
368	!
369
370	IF ( is_tree(j) ) THEN
371
372	!!\latexonly
373	!!\input{stomate_data_stem_diameter.tex}
374	!!\endlatexonly
375
376	maxdia(j) = ( ( pipe_tune4 / ((pipe_tune2pipe_tune3)/(maxdia_coeff(1)*pipe_tune3)) ) &
377	** ( un / ( pipe_tune3 - un ) ) ) * maxdia_coeff(2)
378	cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
379
380	ELSE
381
382	maxdia(j) = undef
383	cn_sapl(j)=1
384
385	ENDIF !( is_tree(j) )
386
387	IF ( printlev >= 2 ) WRITE(numout,*) ' critical stem diameter (m): (::maxdia(j))', maxdia(j)
388
389	!
390	! 8 Coldest tolerable temperature (K)
391	!
392
393	IF ( ABS( tmin_crit(j) - undef ) .GT. min_stomate ) THEN
394	tmin_crit(j) = tmin_crit(j) + ZeroCelsius
395	ELSE
396	tmin_crit(j) = undef
397	ENDIF
398
399	IF ( printlev >= 2 ) &
400	WRITE(numout,*) ' coldest tolerable temperature (K): (::tmin_crit(j))', tmin_crit(j)
401
402	!
403	! 9 Maximum temperature of the coldest month: need to be below this temperature
404	! for a certain time to regrow leaves next spring (vernalization) (K)
405	!
406
407	IF ( ABS ( tcm_crit(j) - undef ) .GT. min_stomate ) THEN
408	tcm_crit(j) = tcm_crit(j) + ZeroCelsius
409	ELSE
410	tcm_crit(j) = undef
411	ENDIF
412
413	IF ( printlev >= 2 ) &
414	WRITE(numout,*) ' vernalization temperature (K): (::tcm_crit(j))', tcm_crit(j)
415
416	!
417	! 10 critical values for phenology
418	!
419
420	! 10.1 model used
421
422	IF ( printlev >= 2 ) &
423	WRITE(numout,*) ' phenology model used: (::pheno_model(j)) ',pheno_model(j)
424
425	! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C
426	! or whatever), depends on how this is used in stomate_phenology.
427
428
429	IF ( ( printlev >= 2 ) .AND. ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) ) THEN
430	WRITE(numout,*) ' critical GDD is a function of long term T (C): (::gdd)'
431	WRITE(numout,*) ' ',pheno_gdd_crit(j,1), &
432	' + T *',pheno_gdd_crit(j,2), &
433	' + T^2 *',pheno_gdd_crit(j,3)
434	ENDIF
435
436	! consistency check
437
438	IF ( ( ( pheno_model(j) .EQ. 'moigdd' ) .OR. &
439	( pheno_model(j) .EQ. 'humgdd' ) ) .AND. &
440	( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) ) THEN
441	CALL ipslerr_p(3,'stomate_data','problem with phenology parameters, critical GDD. (::pheno_model)','','')
442	ENDIF
443
444	! 10.3 number of growing days
445
446	IF ( ( printlev >= 2 ) .AND. ( ngd_crit(j) .NE. undef ) ) &
447	WRITE(numout,*) ' critical NGD: (::ngd_crit(j))', ngd_crit(j)
448
449	! 10.4 critical temperature for ncd vs. gdd function in phenology (C)
450
451	IF ( ( printlev >= 2 ) .AND. ( ncdgdd_temp(j) .NE. undef ) ) &
452	WRITE(numout,*) ' critical temperature for NCD vs. GDD (C): (::ncdgdd_temp(j))', &
453	ncdgdd_temp(j)
454
455	! 10.5 humidity fractions (0-1, unitless)
456
457	IF ( ( printlev >= 2 ) .AND. ( hum_frac(j) .NE. undef ) ) &
458	WRITE(numout,*) ' critical humidity fraction: (::hum_frac(j))', &
459	& hum_frac(j)
460
461
462	! 10.6 minimum time elapsed since moisture minimum (days)
463
464	IF ( ( printlev >= 2 ) .AND. ( hum_min_time(j) .NE. undef ) ) &
465	WRITE(numout,*) ' time to wait after moisture min (d): (::hum_min_time(j))', &
466	& hum_min_time(j)
467
468	!
469	! 11 critical values for senescence
470	!
471
472	! 11.1 type of senescence
473
474	IF ( printlev >= 2 ) &
475	WRITE(numout,*) ' type of senescence: (::senescence_type(j))',senescence_type(j)
476
477	! 11.2 critical temperature for senescence (C)
478
479	IF ( ( printlev >= 2 ) .AND. ( ALL(senescence_temp(j,:) .NE. undef) ) ) THEN
480	WRITE(numout,*) ' critical temperature for senescence (C) is'
481	WRITE(numout,*) ' a function of long term T (C): (::senescence_temp)'
482	WRITE(numout,*) ' ',senescence_temp(j,1), &
483	' + T *',senescence_temp(j,2), &
484	' + T^2 *',senescence_temp(j,3)
485	ENDIF
486
487	! consistency check
488
489	IF ( ( ( senescence_type(j) .EQ. 'cold' ) .OR. &
490	( senescence_type(j) .EQ. 'mixed' ) ) .AND. &
491	( ANY(senescence_temp(j,:) .EQ. undef ) ) ) THEN
492	CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, temperature. (::senescence_type)','','')
493	ENDIF
494
495	! 11.3 critical relative moisture availability for senescence
496
497	IF ( ( printlev >= 2 ) .AND. ( senescence_hum(j) .NE. undef ) ) THEN
498	WRITE(numout,*) ' max. critical relative moisture availability for'
499	WRITE(numout,*) ' senescence: (::senescence_hum(j))', &
500	& senescence_hum(j)
501	END IF
502
503	! consistency check
504
505	IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
506	( senescence_type(j) .EQ. 'mixed' ) ) .AND. &
507	( senescence_hum(j) .EQ. undef ) ) THEN
508	CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, humidity.(::senescence_type)','','')
509	ENDIF
510
511	! 14.3 relative moisture availability above which there is no moisture-related
512	! senescence (0-1, unitless)
513
514	IF ( ( printlev >= 2 ) .AND. ( nosenescence_hum(j) .NE. undef ) ) THEN
515	WRITE(numout,*) ' relative moisture availability above which there is'
516	WRITE(numout,*) ' no moisture-related senescence: (::nosenescence_hum(j))', nosenescence_hum(j)
517	END IF
518	! consistency check
519
520	IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
521	( senescence_type(j) .EQ. 'mixed' ) ) .AND. &
522	( nosenescence_hum(j) .EQ. undef ) ) THEN
523	CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, humidity. (::senescence_type)','','')
524	ENDIF
525
526	!
527	! 12 sapwood -> heartwood conversion time (days)
528	!
529
530	IF ( printlev >= 2 ) &
531	WRITE(numout,*) ' sapwood -> heartwood conversion time (d): (::tau_sap(j))', tau_sap(j)
532
533	!
534	! 13 fruit lifetime (days)
535	!
536
537	IF ( printlev >= 2 ) WRITE(numout,*) ' fruit lifetime (d): (::tau_fruit(j))', tau_fruit(j)
538
539	!
540	! 14 length of leaf death (days)
541	! For evergreen trees, this variable determines the lifetime of the leaves.
542	! Note that it is different from the value given in leaflife_tab.
543	!
544
545	IF ( printlev >= 2 ) &
546	WRITE(numout,*) ' length of leaf death (d): (::leaffall(j))', leaffall(j)
547
548	!
549	! 15 maximum lifetime of leaves (days)
550	!
551
552	IF ( ( printlev >= 2 ) .AND. ( leafagecrit(j) .NE. undef ) ) &
553	WRITE(numout,*) ' critical leaf age (d): (::leafagecrit(j))', leafagecrit(j)
554
555	!
556	! 16 time constant for leaf age discretisation (days)
557	!
558
559	leaf_timecst(j) = leafagecrit(j) / REAL( nleafages,r_std )
560
561	IF ( printlev >= 2 ) &
562	WRITE(numout,*) ' time constant for leaf age discretisation (d): (::leaf_timecst(j))', &
563	leaf_timecst(j)
564
565	!
566	! 17 minimum lai, initial (m^2.m^{-2})
567	!
568
569	IF ( is_tree(j) ) THEN
570	lai_initmin(j) = lai_initmin_tree
571	ELSE
572	lai_initmin(j) = lai_initmin_grass
573	ENDIF !( is_tree(j) )
574
575	IF ( printlev >= 2 ) &
576	WRITE(numout,*) ' initial LAI: (::lai_initmin(j))', lai_initmin(j)
577
578	!
579	! 19 maximum LAI (m^2.m^{-2})
580	!
581
582	IF ( printlev >= 2 ) &
583	WRITE(numout,*) ' critical LAI above which no leaf allocation: (::lai_max(j))', lai_max(j)
584
585	!
586	! 20 fraction of primary leaf and root allocation put into reserve (0-1, unitless)
587	!
588
589	IF ( printlev >= 2 ) &
590	WRITE(numout,*) ' reserve allocation factor: (::ecureuil(j))', ecureuil(j)
591
592	!
593	! 21 maintenance respiration coefficient (g/g/day) at 0 deg C
594	!
595
596	IF ( printlev >= 2 ) THEN
597
598	WRITE(numout,*) ' maintenance respiration coefficient (g/g/day) at 0 deg C:'
599	WRITE(numout,*) ' . leaves: (::coeff_maint_zero(j,ileaf))',coeff_maint_zero(j,ileaf)
600	WRITE(numout,*) ' . sapwood above ground: (::coeff_maint_zero(j,isapabove)) ',&
601	& coeff_maint_zero(j,isapabove)
602	WRITE(numout,*) ' . sapwood below ground: (::coeff_maint_zero(j,isapbelow)) ',&
603	& coeff_maint_zero(j,isapbelow)
604	WRITE(numout,*) ' . heartwood above ground: (::coeff_maint_zero(j,iheartabove)) ',&
605	& coeff_maint_zero(j,iheartabove)
606	WRITE(numout,*) ' . heartwood below ground: (::coeff_maint_zero(j,iheartbelow)) ',&
607	& coeff_maint_zero(j,iheartbelow)
608	WRITE(numout,*) ' . roots: (::coeff_maint_zero(j,iroot))',coeff_maint_zero(j,iroot)
609	WRITE(numout,*) ' . fruits: (::coeff_maint_zero(j,ifruit)) ',coeff_maint_zero(j,ifruit)
610	WRITE(numout,*) ' . carbohydrate reserve: (::coeff_maint_zero(j,icarbres)) ',&
611	& coeff_maint_zero(j,icarbres)
612
613	ENDIF !( printlev >= 2 )
614
615	!
616	! 22 parameter for temperature sensitivity of maintenance respiration
617	!
618
619	IF ( printlev >= 2 ) THEN
620	WRITE(numout,*) ' temperature sensitivity of maintenance respiration (1/K) is'
621	WRITE(numout,*) ' a function of long term T (C): (::maint_resp_slope)'
622	WRITE(numout,) ' ',maint_resp_slope(j,1),' + T ',maint_resp_slope(j,2), &
623	' + T^2 *',maint_resp_slope(j,3)
624	END IF
625	!
626	! 23 natural ?
627	!
628
629	IF ( printlev >= 2 ) &
630	WRITE(numout,*) ' Natural: (::natural(j))', natural(j)
631	! dgvmjc
632	IF ( printlev >= 1 ) &
633	WRITE(numout,*) ' PASTURE: (::pasture(j))', pasture(j)
634	! end dgvmjc
635	!
636	! 24 Vcmax et Vjmax (umol.m^{-2}.s^{-1})
637	!
638
639	IF ( printlev >= 2 ) &
640	WRITE(numout,*) ' Maximum rate of carboxylation: (::Vcmax_25(j))', vcmax25(j)
641	!
642	! 25 constants for photosynthesis temperatures
643	!
644
645	IF ( printlev >= 2 ) THEN
646
647
648	!
649	! 26 Properties
650	!
651
652	WRITE(numout,*) ' C4 photosynthesis: (::is_c4(j))', is_c4(j)
653	WRITE(numout,*) ' Depth constant for root profile (m): (::1./humcste(j))', 1./humcste(j)
654
655	ENDIF
656
657	!
658	! 27 extinction coefficient of the Monsi and Saeki (1953) relationship
659	!
660	IF ( printlev >= 2 ) THEN
661	WRITE(numout,*) ' extinction coefficient: (::ext_coeff(j))', ext_coeff(j)
662	ENDIF
663
664	!
665	! 30 fraction of allocatable biomass which is lost as growth respiration (0-1, unitless)
666	!
667	IF ( printlev >= 2 ) &
668	WRITE(numout,*) ' growth respiration fraction: (::frac_growthresp(j))', frac_growthresp(j)
669
670	ENDDO ! Loop over # PFTS
671
672	!
673	! 29 time scales for phenology and other processes (in days)
674	!
675
676	tau_longterm_max = coeff_tau_longterm * one_year
677
678	IF ( printlev >= 2 ) THEN
679
680	WRITE(numout,*) ' > time scale for ''monthly'' moisture availability (d): (::tau_hum_month)', &
681	tau_hum_month
682	WRITE(numout,*) ' > time scale for ''weekly'' moisture availability (d): (::tau_hum_week)', &
683	tau_hum_week
684	WRITE(numout,*) ' > time scale for ''monthly'' 2 meter temperature (d): (::tau_t2m_month)', &
685	tau_t2m_month
686	WRITE(numout,*) ' > time scale for ''weekly'' 2 meter temperature (d): (::tau_t2m_week)', &
687	tau_t2m_week
688	WRITE(numout,*) ' > time scale for ''weekly'' GPP (d): (::tau_gpp_week)', &
689	tau_gpp_week
690	WRITE(numout,*) ' > time scale for ''monthly'' soil temperature (d): (::tau_tsoil_month)', &
691	tau_tsoil_month
692	WRITE(numout,*) ' > time scale for ''monthly'' soil humidity (d): (::tau_soilhum_month)', &
693	tau_soilhum_month
694	WRITE(numout,*) ' > time scale for vigour calculations (y): (::tau_longterm_max / one_year)', &
695	tau_longterm_max / one_year
696
697	ENDIF
698
699	IF (printlev >= 4) WRITE(numout,*) 'Leaving stomate_data'
700
701	END SUBROUTINE data
702
703	END MODULE stomate_data

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

Context Navigation

source: branches/publications/ORCHIDEE_GLUC_r6545/src_stomate/stomate_data.f90 @ 6737

Download in other formats: