Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

stomate_data.f90 @ 8579

Last change on this file since 8579 was 7454, checked in by josefine.ghattas, 2 years ago
Initialize bm_sapl on all pfts because needed when loops starting from j=1. See ticket #823
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 25.6 KB

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

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

Context Navigation

source: branches/ORCHIDEE_2_2/ORCHIDEE/src_stomate/stomate_data.f90 @ 8579

Download in other formats: