! defines PFT parameters ! the geographical coordinates might be used for defining some additional parameters ! (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.) ! ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_data.f90,v 1.12 2009/06/24 10:53:17 ssipsl Exp $ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_data ! modules used: USE constantes_veg USE constantes_co2 USE stomate_constants IMPLICIT NONE ! private & public routines PRIVATE PUBLIC data CONTAINS SUBROUTINE data (npts, lalo) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! Geographical coordinates (latitude,longitude) REAL(r_std),DIMENSION (npts,2), INTENT (in) :: lalo ! 0.2 local variables ! Index INTEGER(i_std) :: j ! alpha's : ? REAL(r_std) :: alpha ! stem diameter REAL(r_std) :: dia ! Sapling CSA REAL(r_std) :: csa_sap ! mass ratio (heartwood+sapwood)/sapwood REAL(r_std), PARAMETER :: x = 3. ! ========================================================================= IF ( bavard .GE. 1 ) WRITE(numout,*) 'data: PFT characteristics' DO j = 2,nvm IF ( bavard .GE. 1 ) WRITE(numout,'(a,i3,a,a)') ' > PFT#',j,': ', PFT_name(j) ! ! 1 tree? ! IF ( leaf_tab(j) .LE. 2 ) THEN tree(j) = .TRUE. ELSE tree(j) = .FALSE. ENDIF IF ( bavard .GE. 1 ) WRITE(numout,*) ' tree: ', tree(j) ! ! 2 flamability ! IF ( bavard .GE. 1 ) WRITE(numout,*) ' litter flamability:', flam(j) ! ! 3 fire resistance ! IF ( bavard .GE. 1 ) WRITE(numout,*) ' fire resistance:', resist(j) ! ! 4 specific leaf area per mass carbon = 2 * sla / dry mass ! ! SZ: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous ! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function ! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is: ! sla=exp(5.615-0.46*ln(leaflon in months)) ! includes conversion from !! sla(j) = 2. * 1e-4 * EXP(5.615 - 0.46 * log(12./leaflife_tab(j))) IF ( leaf_tab(j) .EQ. 2 ) THEN ! needle leaved tree sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4 ELSE ! broad leaved tree or grass (Reich et al 1992) sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4 ENDIF !!$ IF ( leaf_tab(j) .EQ. 1 ) THEN !!$ !!$ ! broad leaved tree !!$ !!$ sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4 !!$ !!$ ELSE !!$ !!$ ! needle leaved or grass (Reich et al 1992) !!$ !!$ sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4 !!$ !!$ ENDIF !!$ !!$ IF ( ( leaf_tab(j) .EQ. 2 ) .AND. ( pheno_type_tab(j) .EQ. 2 ) ) THEN !!$ !!$ ! summergreen needle leaf !!$ !!$ sla(j) = 1.25 * sla(j) !!$ !!$ ENDIF IF ( bavard .GE. 1 ) WRITE(numout,*) ' specific leaf area (m**2/gC):', sla(j), 12./leaflife_tab(j) ! ! 5 sapling characteristics ! IF ( tree(j) ) THEN ! 5.1 trees alpha = alpha_tree bm_sapl(j,ileaf) = & ( (4.*pipe_tune1 * ( x*4.*sla(j)/(pi*pipe_k1))**.8 ) / sla(j) ) ** 5. IF ( pheno_type_tab(j) .NE. 1 ) THEN ! not evergreen bm_sapl(j,icarbres) = 5. * bm_sapl(j,ileaf) ELSE bm_sapl(j,icarbres) = 0.0 ENDIF csa_sap = bm_sapl(j,ileaf) / ( pipe_k1 / sla(j) ) dia = ( x * csa_sap * 4. / pi ) ** 0.5 bm_sapl(j,isapabove) = & .5 * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3 bm_sapl(j,isapbelow) = bm_sapl(j,isapabove) bm_sapl(j,iheartabove) = 2. * bm_sapl(j,isapabove) bm_sapl(j,iheartbelow) = 2. * bm_sapl(j,isapbelow) ELSE ! 5.2 grasses alpha = alpha_grass IF ( natural(j) ) THEN bm_sapl(j,ileaf) = 0.1 / sla(j) ELSE bm_sapl(j,ileaf) = 1.0 / sla(j) ENDIF bm_sapl(j,icarbres) = 5.*bm_sapl(j,ileaf) bm_sapl(j,isapabove) = 0. bm_sapl(j,isapbelow) = 0. bm_sapl(j,iheartabove) = 0. bm_sapl(j,iheartbelow) = 0. ENDIF bm_sapl(j,iroot) = 0.1 * (1./alpha) * bm_sapl(j,ileaf) bm_sapl(j,ifruit) = 0.3 * bm_sapl(j,ileaf) IF ( bavard .GE. 1 ) THEN WRITE(numout,*) ' sapling biomass (gC):' WRITE(numout,*) ' leaves:',bm_sapl(j,ileaf) WRITE(numout,*) ' sap above ground:',bm_sapl(j,isapabove) WRITE(numout,*) ' sap below ground:',bm_sapl(j,isapbelow) WRITE(numout,*) ' heartwood above ground:',bm_sapl(j,iheartabove) WRITE(numout,*) ' heartwood below ground:',bm_sapl(j,iheartbelow) WRITE(numout,*) ' roots:',bm_sapl(j,iroot) WRITE(numout,*) ' fruits:',bm_sapl(j,ifruit) WRITE(numout,*) ' carbohydrate reserve:',bm_sapl(j,icarbres) ENDIF ! ! 6 migration speed (m/year) ! IF ( tree(j) ) THEN migrate(j) = 10.*1.E3 ELSE ! can be any value as grasses are, per definitionem, everywhere (big leaf). migrate(j) = 10.*1.E3 ENDIF IF ( bavard .GE. 1 ) WRITE(numout,*) ' migration speed (m/year):', migrate(j) ! ! 7 critical stem diameter: beyond this diameter, the crown area no longer ! increases ! IF ( tree(j) ) THEN maxdia(j) = ( ( pipe_tune4 / ((pipe_tune2*pipe_tune3)/(100.**pipe_tune3)) ) & ** ( 1. / ( pipe_tune3 - 1. ) ) ) * 0.01 cn_sapl(j) =0.5 !crown of individual tree, first year ELSE maxdia(j) = undef cn_sapl(j)=1 ENDIF IF ( bavard .GE. 1 ) WRITE(numout,*) ' critical stem diameter (m):', maxdia(j) ! ! 8 Coldest tolerable temperature ! IF ( ABS( tmin_crit_tab(j) - undef ) .GT. min_stomate ) THEN tmin_crit(j) = tmin_crit_tab(j) + ZeroCelsius ELSE tmin_crit(j) = undef ENDIF IF ( bavard .GE. 1 ) & WRITE(numout,*) ' coldest tolerable temperature (K):', tmin_crit(j) ! ! 9 Maximum temperature of the coldest month: need to be below this temperature ! for a certain time to regrow leaves next spring ! IF ( ABS ( tcm_crit_tab(j) - undef ) .GT. min_stomate ) THEN tcm_crit(j) = tcm_crit_tab(j) + ZeroCelsius ELSE tcm_crit(j) = undef ENDIF IF ( bavard .GE. 1 ) & WRITE(numout,*) ' vernalization temperature (K):', tcm_crit(j) ! ! 10 critical values for phenology ! ! 10.1 model used pheno_crit%pheno_model(j) = pheno_model_tab(j) IF ( bavard .GE. 1 ) & WRITE(numout,*) ' phenology model used: ',pheno_crit%pheno_model(j) ! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C ! or whatever), depends on how this is used in stomate_phenology. pheno_crit%gdd(j,1) = gdd_crit1_tab(j) pheno_crit%gdd(j,2) = gdd_crit2_tab(j) pheno_crit%gdd(j,3) = gdd_crit3_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_crit%gdd(j,:) .NE. undef) ) ) THEN WRITE(numout,*) ' critical GDD is a function of long term T (C):' WRITE(numout,*) ' ',pheno_crit%gdd(j,1), & ' + T *',pheno_crit%gdd(j,2), & ' + T^2 *',pheno_crit%gdd(j,3) ENDIF ! consistency check IF ( ( ( pheno_crit%pheno_model(j) .EQ. 'moigdd' ) .OR. & ( pheno_crit%pheno_model(j) .EQ. 'humgdd' ) ) .AND. & ( ANY(pheno_crit%gdd(j,:) .EQ. undef) ) ) THEN STOP 'problem with phenology parameters, critical GDD.' ENDIF ! 10.3 number of growing days pheno_crit%ngd(j) = ngd_crit_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%ngd(j) .NE. undef ) ) & WRITE(numout,*) ' critical NGD:', pheno_crit%ngd(j) ! 10.4 critical temperature for ncd vs. gdd function in phenology pheno_crit%ncdgdd_temp(j) = ncdgdd_temp_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%ncdgdd_temp(j) .NE. undef ) ) & WRITE(numout,*) ' critical temperature for NCD vs. GDD (C):', & pheno_crit%ncdgdd_temp(j) ! 10.5 humidity fractions pheno_crit%hum_frac(j) = hum_frac_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%hum_frac(j) .NE. undef ) ) & WRITE(numout,*) ' critical humidity fraction:', pheno_crit%hum_frac(j) ! 10.6 minimum time during which there was no photosynthesis pheno_crit%lowgpp_time(j) = lowgpp_time_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%lowgpp_time(j) .NE. undef ) ) & WRITE(numout,*) ' minimum dormance duration (d):', pheno_crit%lowgpp_time(j) ! 10.7 minimum time elapsed since moisture minimum (d) pheno_crit%hum_min_time(j) = hum_min_time_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%hum_min_time(j) .NE. undef ) ) & WRITE(numout,*) ' time to wait after moisture min (d):', pheno_crit%hum_min_time(j) ! ! 11 critical values for senescence ! ! 11.1 type of senescence pheno_crit%senescence_type(j) = senescence_type_tab(j) IF ( bavard .GE. 1 ) & WRITE(numout,*) ' type of senescence: ',pheno_crit%senescence_type(j) ! 11.2 critical temperature for senescence pheno_crit%senescence_temp(j,1) = senescence_temp1_tab(j) pheno_crit%senescence_temp(j,2) = senescence_temp2_tab(j) pheno_crit%senescence_temp(j,3) = senescence_temp3_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_crit%senescence_temp(j,:) .NE. undef) ) ) THEN WRITE(numout,*) ' critical temperature for senescence (C) is' WRITE(numout,*) ' a function of long term T (C):' WRITE(numout,*) ' ',pheno_crit%senescence_temp(j,1), & ' + T *',pheno_crit%senescence_temp(j,2), & ' + T^2 *',pheno_crit%senescence_temp(j,3) ENDIF ! consistency check IF ( ( ( pheno_crit%senescence_type(j) .EQ. 'cold' ) .OR. & ( pheno_crit%senescence_type(j) .EQ. 'mixed' ) ) .AND. & ( ANY(pheno_crit%senescence_temp(j,:) .EQ. undef ) ) ) THEN STOP 'problem with senescence parameters, temperature.' ENDIF ! 11.3 critical relative moisture availability for senescence pheno_crit%senescence_hum(j) = senescence_hum_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%senescence_hum(j) .NE. undef ) ) & WRITE(numout,*) ' max. critical relative moisture availability for senescence:', & pheno_crit%senescence_hum(j) ! consistency check IF ( ( ( pheno_crit%senescence_type(j) .EQ. 'dry' ) .OR. & ( pheno_crit%senescence_type(j) .EQ. 'mixed' ) ) .AND. & ( pheno_crit%senescence_hum(j) .EQ. undef ) ) THEN STOP 'problem with senescence parameters, humidity.' ENDIF ! 14.3 relative moisture availability above which there is no moisture-related ! senescence pheno_crit%nosenescence_hum(j) = nosenescence_hum_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%nosenescence_hum(j) .NE. undef ) ) & WRITE(numout,*) ' relative moisture availability above which there is' WRITE(numout,*) ' no moisture-related senescence:', & pheno_crit%nosenescence_hum(j) pheno_crit% max_turnover_time(j) = max_turnover_time_tab(j) pheno_crit% min_turnover_time(j) = min_turnover_time_tab(j) pheno_crit% min_leaf_age_for_senescence(j) = min_leaf_age_for_senescence_tab(j) ! consistency check IF ( ( ( pheno_crit%senescence_type(j) .EQ. 'dry' ) .OR. & ( pheno_crit%senescence_type(j) .EQ. 'mixed' ) ) .AND. & ( pheno_crit%nosenescence_hum(j) .EQ. undef ) ) THEN STOP 'problem with senescence parameters, humidity.' ENDIF ! ! 12 sapwood -> heartwood conversion time ! IF ( bavard .GE. 1 ) & WRITE(numout,*) ' sapwood -> heartwood conversion time (d):', tau_sap(j) ! ! 13 fruit lifetime ! IF ( bavard .GE. 1 ) WRITE(numout,*) ' fruit lifetime (d):', tau_fruit(j) ! ! 14 length of leaf death ! For evergreen trees, this variable determines the lifetime of the leaves. ! Note that it is different from the value given in leaflife_tab. ! pheno_crit%leaffall(j) = leaffall_tab(j) IF ( bavard .GE. 1 ) & WRITE(numout,*) ' length of leaf death (d):', pheno_crit%leaffall(j) ! ! 15 maximum lifetime of leaves ! pheno_crit%leafagecrit(j) = leafagecrit_tab(j) IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%leafagecrit(j) .NE. undef ) ) & WRITE(numout,*) ' critical leaf age (d):', pheno_crit%leafagecrit(j) ! ! 16 time constant for leaf age discretisation (d) ! leaf_timecst(j) = pheno_crit%leafagecrit(j) / REAL( nleafages,r_std ) IF ( bavard .GE. 1 ) & WRITE(numout,*) ' time constant for leaf age discretisation (d):', & leaf_timecst(j) ! ! 17 minimum lai, initial ! IF ( tree(j) ) THEN pheno_crit%lai_initmin(j) = 0.3 ELSE pheno_crit%lai_initmin(j) = 0.1 ENDIF IF ( bavard .GE. 1 ) & WRITE(numout,*) ' initial LAI:', pheno_crit%lai_initmin(j) ! ! 19 maximum LAI ! IF ( bavard .GE. 1 ) & WRITE(numout,*) ' critical LAI above which no leaf allocation:', lai_max(j) ! ! 20 fraction of primary leaf and root allocation put into reserve ! IF ( bavard .GE. 1 ) & WRITE(numout,*) ' reserve allocation factor:', ecureuil(j) ! ! 21 maintenance respiration coefficient (g/g/day) at 0 deg C ! coeff_maint_zero(j,ileaf) = cm_zero_leaf_tab(j) coeff_maint_zero(j,isapabove) = cm_zero_sapabove_tab(j) coeff_maint_zero(j,isapbelow) = cm_zero_sapbelow_tab(j) coeff_maint_zero(j,iheartabove) = cm_zero_heartabove_tab(j) coeff_maint_zero(j,iheartbelow) = cm_zero_heartbelow_tab(j) coeff_maint_zero(j,iroot) = cm_zero_root_tab(j) coeff_maint_zero(j,ifruit) = cm_zero_fruit_tab(j) coeff_maint_zero(j,icarbres) = cm_zero_carbres_tab(j) IF ( bavard .GE. 1 ) THEN WRITE(numout,*) ' maintenance respiration coefficient (g/g/day) at 0 deg C:' WRITE(numout,*) ' . leaves: ',coeff_maint_zero(j,ileaf) WRITE(numout,*) ' . sapwood above ground: ',coeff_maint_zero(j,isapabove) WRITE(numout,*) ' . sapwood below ground: ',coeff_maint_zero(j,isapbelow) WRITE(numout,*) ' . heartwood above ground: ',coeff_maint_zero(j,iheartabove) WRITE(numout,*) ' . heartwood below ground: ',coeff_maint_zero(j,iheartbelow) WRITE(numout,*) ' . roots: ',coeff_maint_zero(j,iroot) WRITE(numout,*) ' . fruits: ',coeff_maint_zero(j,ifruit) WRITE(numout,*) ' . carbohydrate reserve: ',coeff_maint_zero(j,icarbres) ENDIF ! ! 22 parameter for temperature sensitivity of maintenance respiration ! maint_resp_slope(j,1) = maint_resp_slope1_tab(j) maint_resp_slope(j,2) = maint_resp_slope2_tab(j) maint_resp_slope(j,3) = maint_resp_slope3_tab(j) IF ( bavard .GE. 1 ) & WRITE(numout,*) ' temperature sensitivity of maintenance respiration (1/K) is' WRITE(numout,*) ' a function of long term T (C):' WRITE(numout,*) ' ',maint_resp_slope(j,1),' + T *',maint_resp_slope(j,2), & ' + T^2 *',maint_resp_slope(j,3) ! ! 23 natural ? ! IF ( bavard .GE. 1 ) & WRITE(numout,*) ' Natural:', natural(j) ! ! 24 Vcmax et Vjmax ! IF ( bavard .GE. 1 ) & WRITE(numout,*) ' Maximum rate of carboxylation:', vcmax_opt(j) IF ( bavard .GE. 1 ) & WRITE(numout,*) ' Maximum rate of RUbp regeneration:', vjmax_opt(j) ! ! 25 constants for photosynthesis temperatures ! t_photo%t_min_a(j) = tphoto_min_a_tab(j) t_photo%t_min_b(j) = tphoto_min_b_tab(j) t_photo%t_min_c(j) = tphoto_min_c_tab(j) t_photo%t_opt_a(j) = tphoto_opt_a_tab(j) t_photo%t_opt_b(j) = tphoto_opt_b_tab(j) t_photo%t_opt_c(j) = tphoto_opt_c_tab(j) t_photo%t_max_a(j) = tphoto_max_a_tab(j) t_photo%t_max_b(j) = tphoto_max_b_tab(j) t_photo%t_max_c(j) = tphoto_max_c_tab(j) IF ( bavard .GE. 1 ) THEN WRITE(numout,*) ' min. temperature for photosynthesis as a function of long term T (C):' WRITE(numout,*) ' ',t_photo%t_min_c(j), & ' + T*',t_photo%t_min_b(j), & ' + T^2*',t_photo%t_min_a(j) WRITE(numout,*) ' opt. temperature for photosynthesis as a function of long term T (C):' WRITE(numout,*) ' ',t_photo%t_opt_c(j), & ' + T*',t_photo%t_opt_b(j), & ' + T^2*',t_photo%t_opt_a(j) WRITE(numout,*) ' max. temperature for photosynthesis as a function of long term T (C):' WRITE(numout,*) ' ',t_photo%t_max_c(j), & ' + T*',t_photo%t_max_b(j), & ' + T^2*',t_photo%t_max_a(j) ! ! 26 Properties ! WRITE(numout,*) ' Slope of the gs/A relation:', gsslope(j) WRITE(numout,*) ' Intercept of the gs/A relation:', gsoffset(j) WRITE(numout,*) ' C4 photosynthesis:', is_c4(j) WRITE(numout,*) ' Depth constant for root profile (m):', 1./humcste(j) ENDIF ! ! 27 extinction coefficient of the Monsi&Seaki (53) relationship ! ext_coeff(j) = ext_coef(j) IF ( bavard .GE. 1 ) THEN WRITE(numout,*) ' extinction coefficient:', ext_coeff(j) ENDIF ! ! 28 check coherence between tree definitions ! this is not absolutely necessary (just security) ! IF ( tree(j) .NEQV. is_tree(j) ) THEN STOP 'Definition of tree/not tree not coherent' ENDIF ENDDO ! ! 29 time scales for phenology and other processes (in days) ! pheno_crit%tau_hum_month = 20. ! (!) pheno_crit%tau_hum_week = 7. pheno_crit%tau_t2m_month = 20. ! (!) pheno_crit%tau_t2m_week = 7. pheno_crit%tau_tsoil_month = 20. ! (!) pheno_crit%tau_soilhum_month = 20. ! (!) pheno_crit%tau_gpp_week = 7. pheno_crit%tau_gdd = 40. pheno_crit%tau_ngd = 50. pheno_crit%tau_longterm = 3. * one_year IF ( bavard .GE. 1 ) THEN WRITE(numout,*) ' > time scale for ''monthly'' moisture availability (d):', & pheno_crit%tau_hum_month WRITE(numout,*) ' > time scale for ''weekly'' moisture availability (d):', & pheno_crit%tau_hum_week WRITE(numout,*) ' > time scale for ''monthly'' 2 meter temperature (d):', & pheno_crit%tau_t2m_month WRITE(numout,*) ' > time scale for ''weekly'' 2 meter temperature (d):', & pheno_crit%tau_t2m_week WRITE(numout,*) ' > time scale for ''weekly'' GPP (d):', & pheno_crit%tau_gpp_week WRITE(numout,*) ' > time scale for ''monthly'' soil temperature (d):', & pheno_crit%tau_tsoil_month WRITE(numout,*) ' > time scale for ''monthly'' soil humidity (d):', & pheno_crit%tau_soilhum_month WRITE(numout,*) ' > time scale for vigour calculations (y):', & pheno_crit%tau_longterm / one_year ENDIF ! ! 30 fraction of allocatable biomass which is lost as growth respiration ! IF ( bavard .GE. 1 ) & WRITE(numout,*) ' > growth respiration fraction:', frac_growthresp IF (bavard.GE.4) WRITE(numout,*) 'Leaving data' END SUBROUTINE data END MODULE stomate_data