!$Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parameters/constantes.f90,v 1.16 2007/08/01 15:19:05 ssipsl Exp $ !IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC !- MODULE constantes !!-------------------------------------------------------------------- !! "constantes" module contains some public technical constants !!-------------------------------------------------------------------- USE defprec USE ioipsl !- IMPLICIT NONE !- !------------------------- ! ORCHIDEE CONSTANTS !------------------------ !---------------- ! Global !---------------- ! Unit for output messages INTEGER(i_std), SAVE :: numout = 6 !- ! To set for more printing LOGICAL,SAVE :: long_print = .FALSE. !- ! One of the most frequent problems is a temperature out of range ! we provide here a way to catch that in the calling procedure. (JP) LOGICAL,PARAMETER :: diag_qsat = .TRUE. !!$ ! One of the most frequent problems is a temperature out of range !!$ ! we provide here a way to catch that in the calling procedure. (JP) !!$ LOGICAL,SAVE :: diag_qsat = .TRUE. !- ! Selects the type of output for the model. ! Value is read from run.def in intersurf_history. LOGICAL :: almaoutput !- ! One day in seconds REAL(r_std),SAVE :: one_day ! One year in seconds REAL(r_std),SAVE :: one_year ! undef integer for integer arrays INTEGER(i_std), PARAMETER :: undef_integer = 999999999 ! Specific value if no restart value REAL(r_std),SAVE :: val_exp = 999999. ! Special value for stomate REAL(r_std),PARAMETER :: undef = -9999. ! Epsilon to detect a near zero floating point REAL(r_std),PARAMETER :: min_sechiba = 1.E-8_r_std ! The undef value used in SECHIBA REAL(r_std),PARAMETER :: undef_sechiba = 1.E+20_r_std ! Epsilon to detect a near zero floating point REAL(r_std),PARAMETER :: min_stomate = 1.E-8_r_std ! some large value (for stomate) REAL(r_std),PARAMETER :: large_value = 1.E33_r_std !- TYPE control_type LOGICAL :: river_routing LOGICAL :: hydrol_cwrr LOGICAL :: ok_sechiba LOGICAL :: ok_co2 LOGICAL :: ok_stomate LOGICAL :: ok_dgvm LOGICAL :: stomate_watchout LOGICAL :: ok_pheno END TYPE control_type ! Flags that (de)activate parts of the model TYPE(control_type),SAVE :: control !- !--------------------------------------- ! DIMENSIONING AND INDICES PARAMETERS !--------------------------------------- !---------------- ! qsat_moisture !---------------- ! Number of other surface types: land ice (lakes,cities, ...) INTEGER(i_std),PARAMETER :: nnobio=1 !- ! Index for land ice (see nnobio) INTEGER(i_std),PARAMETER :: iice = 1 !------- ! Soil !------- ! Number of soil level INTEGER(i_std),PARAMETER :: ngrnd=7 !- ! Number of diagnostic levels in the soil INTEGER(i_std),PARAMETER :: nbdl=11 !MM : if you want to compare hydrology variables with old TAG 1.6 and lower, ! you must set the Number of diagnostic levels in the soil to 6 : ! INTEGER(i_std),PARAMETER :: nbdl=6 !- ! Number of levels in CWRR INTEGER(i_std),PARAMETER :: nslm=11 !- ! Number of soil types INTEGER(i_std),PARAMETER :: nstm = 3 !- ! Dimensioning parameter for the soil color numbers and their albedo INTEGER(i_std), PARAMETER :: classnb = 9 !- ! Diagnostic variables !- ! The lower limit of the layer on which soil moisture (relative) ! and temperature are going to be diagnosed. ! These variables are made for transfering the information ! to the biogeophyical processes modelled in STOMATE. !- REAL(r_std),DIMENSION(nbdl),SAVE :: diaglev !----------------- ! STOMATE - LPJ !----------------- ! NV080800 Name of STOMATE forcing file CHARACTER(LEN=100) :: stomate_forcing_name='NONE' !- ! NV080800 Name of soil forcing file CHARACTER(LEN=100) :: stomate_Cforcing_name='NONE' !- INTEGER(i_std),SAVE :: forcing_id !- ! leaf age discretisation ( 1 = no discretisation ) INTEGER(i_std),PARAMETER :: nleafages = 4 ! !---------------------------- ! litter fractions: indices !---------------------------- INTEGER(i_std),PARAMETER :: ileaf = 1 INTEGER(i_std),PARAMETER :: isapabove = 2 INTEGER(i_std),PARAMETER :: isapbelow = 3 INTEGER(i_std),PARAMETER :: iheartabove = 4 INTEGER(i_std),PARAMETER :: iheartbelow = 5 INTEGER(i_std),PARAMETER :: iroot = 6 INTEGER(i_std),PARAMETER :: ifruit = 7 INTEGER(i_std),PARAMETER :: icarbres = 8 INTEGER(i_std),PARAMETER :: nparts = 8 ! !------------------------------------- ! indices for assimilation parameters !------------------------------------- INTEGER(i_std),PARAMETER :: itmin = 1 INTEGER(i_std),PARAMETER :: itopt = 2 INTEGER(i_std),PARAMETER :: itmax = 3 INTEGER(i_std),PARAMETER :: ivcmax = 4 INTEGER(i_std),PARAMETER :: ivjmax = 5 INTEGER(i_std),PARAMETER :: npco2 = 5 !- !------------------------------------------ ! trees and litter: indices for the parts of heart- and sapwood above ! and below the ground !----------------------------------------- INTEGER(i_std),PARAMETER :: iabove = 1 INTEGER(i_std),PARAMETER :: ibelow = 2 INTEGER(i_std),PARAMETER :: nlevs = 2 !- !--------------------------------------------------- ! litter: indices for metabolic and structural part !-------------------------------------------------- INTEGER(i_std),PARAMETER :: imetabolic = 1 INTEGER(i_std),PARAMETER :: istructural = 2 INTEGER(i_std),PARAMETER :: nlitt = 2 ! !----------------------- ! carbon pools: indices !----------------------- INTEGER(i_std),PARAMETER :: iactive = 1 INTEGER(i_std),PARAMETER :: islow = 2 INTEGER(i_std),PARAMETER :: ipassive = 3 INTEGER(i_std),PARAMETER :: ncarb = 3 !------------------------------ ! MATH AND PHYSICS CONSTANTS !------------------------------ !------------------------------------ ! 1 . Maths and numerical constants !------------------------------------ ! pi REAL(r_std), PARAMETER :: pi = 4.*ATAN(1.) ! e REAL(r_std),PARAMETER :: euler = 2.71828182846 !- ! Integer constant set to zero INTEGER(i_std), PARAMETER :: zero_int = 0 !- ! Numerical constant set to 0 REAL(r_std),PARAMETER :: zero = 0._r_std ! Numerical constant set to 1/2 REAL(r_std),PARAMETER :: undemi = 0.5_r_std ! Numerical constant set to 1 REAL(r_std),PARAMETER :: un = 1._r_std ! Numerical constant set to -1 REAL(r_std),PARAMETER :: moins_un = -1._r_std ! Numerical constant set to 2 REAL(r_std),PARAMETER :: deux = 2._r_std ! Numerical constant set to 3 REAL(r_std),PARAMETER :: trois = 3._r_std ! Numerical constant set to 4 REAL(r_std),PARAMETER :: quatre = 4._r_std ! Numerical constant set to 5 REAL(r_std),PARAMETER :: cinq = 5._r_std ! Numerical constant set to 6 REAL(r_std),PARAMETER :: six = 6._r_std ! Numerical constant set to 8 REAL(r_std),PARAMETER :: huit = 8._r_std ! Numerical constant set to 1000 REAL(r_std),PARAMETER :: mille = 1000._r_std !--------------- ! 2 . Physics !--------------- ! ! radius of the Earth (m) REAL(r_std), PARAMETER :: R_Earth = 6378000. ! standard pressure REAL(r_std), PARAMETER :: pb_std = 1013. !- ! Freezing point REAL(r_std),PARAMETER :: ZeroCelsius = 273.15 !- ! 0 degre Celsius in degre Kelvin REAL(r_std),PARAMETER :: tp_00=273.15 !- ! Latent heat of sublimation REAL(r_std),PARAMETER :: chalsu0 = 2.8345E06 ! Latent heat of evaporation REAL(r_std),PARAMETER :: chalev0 = 2.5008E06 ! Latent heat of fusion REAL(r_std),PARAMETER :: chalfu0 = chalsu0-chalev0 !- ! Stefan-Boltzman constant REAL(r_std),PARAMETER :: c_stefan = 5.6697E-8 ! Specific heat of air REAL(r_std),PARAMETER :: cp_air = 1004.675 ! Constante molere REAL(r_std),PARAMETER :: cte_molr = 287.05 ! Kappa REAL(r_std),PARAMETER :: kappa = cte_molr/cp_air ! in -- Kg/mole REAL(r_std),PARAMETER :: msmlr_air = 28.964E-03 ! in -- Kg/mole REAL(r_std),PARAMETER :: msmlr_h2o = 18.02E-03 !- REAL(r_std),PARAMETER :: cp_h2o = & & cp_air*(quatre*msmlr_air)/( 3.5_r_std*msmlr_h2o) !- REAL(r_std),PARAMETER :: cte_molr_h2o = cte_molr/quatre !- REAL(r_std),PARAMETER :: retv = msmlr_air/msmlr_h2o-un !- REAL(r_std),PARAMETER :: rvtmp2 = cp_h2o/cp_air-un !- REAL(r_std),PARAMETER :: cepdu2 = (0.1_r_std) **2 !- ! Van Karmann Constante REAL(r_std),PARAMETER :: ct_karman = 0.35_r_std !- ! g acceleration REAL(r_std),PARAMETER :: cte_grav = 9.80665_r_std !- ! Transform pascal into hectopascal REAL(r_std),PARAMETER :: pa_par_hpa = 100._r_std !------------------------------------- ! 2.1. Climatic constantes !------------------------------------- ! !$$ To externalise or not ? ! ! Constantes of the Louis scheme REAL(r_std),PARAMETER :: cb = cinq REAL(r_std),PARAMETER :: cc = cinq REAL(r_std),PARAMETER :: cd = cinq !- ! Constant in the computation of surface resistance REAL(r_std),PARAMETER :: rayt_cste = 125. !- ! DS :both used in diffuco.f90 ! Constant in the computation of surface resistance REAL(r_std),PARAMETER :: defc_plus=23.E-3 ! Constant in the computation of surface resistance REAL(r_std),PARAMETER :: defc_mult=1.5 !----------------------------------------- ! 2.2 Soil thermodynamics constants !----------------------------------------- ! ! Average Thermal Conductivity of soils REAL(r_std),PARAMETER :: so_cond = 1.5396 ! Average Heat capacity of soils REAL(r_std),PARAMETER :: so_capa = 2.0514e+6 !- ! Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384 ! Dry soil heat capacity was decreased and conductivity increased. !- ! To externalise ? ! Dry soil Heat capacity of soils !*REAL(r_std),PARAMETER :: so_capa_dry = 1.35e+6 REAL(r_std),PARAMETER :: so_capa_dry = 1.80e+6 ! Dry soil Thermal Conductivity of soils !*REAL(r_std),PARAMETER :: so_cond_dry = 0.28 REAL(r_std),PARAMETER :: so_cond_dry = 0.40 !- ! Wet soil Heat capacity of soils REAL(r_std),PARAMETER :: so_capa_wet = 3.03e+6 ! Wet soil Thermal Conductivity of soils REAL(r_std),PARAMETER :: so_cond_wet = 1.89 !- ! Thermal Conductivity of snow REAL(r_std),PARAMETER :: sn_cond = 0.3 ! Snow density for the soil thermodynamics REAL(r_std),PARAMETER :: sn_dens = 330.0 ! Heat capacity for snow REAL(r_std),PARAMETER :: sn_capa = 2100.0_r_std*sn_dens !----------------------------------------------- !---------------------------------------------- ! SCALAR PARAMETERS EXTERNALIZED !---------------------------------------------- !----------------------------------------------- !------------------------------------------ ! SECHIBA, SOIL AND VEGETATION parameters !----------------------------------------- !!--------------------------------------- !! Parameters for soil type distribution !!--------------------------------------- ! ! Default soil texture distribution in the following order : ! sand, loam and clay REAL(r_std),SAVE, DIMENSION(nstm) :: soiltype_default = (/ 0.0, 1.0, 0.0 /) !!---------------------------------------- !! Constantes from the Choisnel hydrology !!---------------------------------------- ! ! Wilting point (Has a numerical role for the moment) REAL(r_std),SAVE :: qwilt = 5.0 ! Total depth of soil reservoir (for hydrolc) REAL(r_std),SAVE :: dpu_cste = deux ! The minimal size we allow for the upper reservoir (m) REAL(r_std),SAVE :: min_resdis = 2.e-5 !- ! Diffusion constant for the slow regime ! (This is for the diffusion between reservoirs) REAL(r_std),SAVE :: min_drain = 0.001 ! Diffusion constant for the fast regime REAL(r_std),SAVE :: max_drain = 0.1 ! The exponential in the diffusion law REAL(r_std),SAVE :: exp_drain = 1.5 !- ! Transforms leaf area index into size of interception reservoir REAL(r_std),SAVE :: qsintcst = 0.1 ! Maximum quantity of water (Kg/M3) REAL(r_std),SAVE :: mx_eau_eau = 150. !- ! Constant in the computation of resistance for bare soil evaporation REAL(r_std),SAVE :: rsol_cste = 33.E3 ! Scaling depth for litter humidity (m) !SZ changed this according to SP from 0.03 to 0.08, 080806 REAL(r_std),SAVE :: hcrit_litter=0.08_r_std !!--------------------------------------------------- !! Specific parameters for the CWRR hydrology module !!--------------------------------------------------- ! !!$ DS To externalise ? !!$ advice of MM : to put in hydrol ! CWRR linearisation INTEGER(i_std),PARAMETER :: imin = 1 ! number of interval for CWRR INTEGER(i_std),PARAMETER :: nbint = 100 ! number of points for CWRR INTEGER(i_std),PARAMETER :: imax = nbint+1 !- ! externalise w_time (some bug in hydrol) ! Time weighting for discretisation REAL(r_std),SAVE :: w_time = un !- ! Van genuchten coefficient n REAL(r_std),SAVE,DIMENSION(nstm) :: nvan = (/ 1.89_r_std, 1.56_r_std, 1.31_r_std /) ! Van genuchten coefficient a (mm^{-1}) REAL(r_std),SAVE,DIMENSION(nstm) :: avan = (/ 0.0075_r_std, 0.0036_r_std, 0.0019_r_std /) !- ! Residual soil water content REAL(r_std),SAVE,DIMENSION(nstm) :: mcr = (/ 0.065_r_std, 0.078_r_std, 0.095_r_std /) ! Saturated soil water content REAL(r_std),SAVE,DIMENSION(nstm) :: mcs = (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /) ! Total depth of soil reservoir (m) REAL(r_std),SAVE,DIMENSION(nstm) :: dpu = (/ 2.0_r_std, 2.0_r_std, 2.0_r_std /) !- ! dpu must be constant over the different soil types ! Hydraulic conductivity Saturation (mm/d) REAL(r_std),SAVE,DIMENSION(nstm) :: ks = (/ 1060.8_r_std, 249.6_r_std, 62.4_r_std /) ! Soil moisture above which transpir is max REAL(r_std),SAVE,DIMENSION(nstm) :: pcent = (/ 0.5_r_std, 0.5_r_std, 0.5_r_std /) ! Max value of the permeability coeff at the bottom of the soil REAL(r_std),SAVE,DIMENSION(nstm) :: free_drain_max = (/ 1.0_r_std, 1.0_r_std, 1.0_r_std /) !- ! Volumetric water content field capacity REAL(r_std),SAVE,DIMENSION(nstm) :: mcf = (/ 0.32_r_std, 0.32_r_std, 0.32_r_std /) ! Volumetric water content Wilting pt REAL(r_std),SAVE,DIMENSION(nstm) :: mcw = (/ 0.10_r_std, 0.10_r_std, 0.10_r_std /) ! Vol. wat. cont. above which albedo is cst REAL(r_std),SAVE,DIMENSION(nstm) :: mc_awet = (/ 0.25_r_std, 0.25_r_std, 0.25_r_std /) ! Vol. wat. cont. below which albedo is cst REAL(r_std),SAVE,DIMENSION(nstm) :: mc_adry = (/ 0.1_r_std, 0.1_r_std, 0.1_r_std /) !!----------------------------------------------------- !! Vegetation parameters (previously in constantes_veg) !!----------------------------------------------------- ! ! Value for frac_nobio for tests in 0-dim simulations ! laisser ca tant qu'il n'y a que de la glace (pas de lacs) !DS : used in slowproc REAL(r_std),SAVE :: frac_nobio_fixed_test_1 = 0.0 !- ! Is veget_ori array stored in restart file !!$ DS: Where is it used ? ! LOGICAL,PARAMETER :: ldveget_ori_on_restart = .TRUE. !- ! Set to .TRUE. if you want q_cdrag coming from GCM ! used in diffuco LOGICAL,SAVE :: ldq_cdrag_from_gcm = .FALSE. !- ! allow agricultural PFTs LOGICAL,SAVE :: agriculture = .TRUE. !- ! The maximum mass (kg/m^2) of a glacier. REAL(r_std),SAVE :: maxmass_glacier = 3000. !- ! Minimal fraction of mesh a vegetation type can occupy REAL(r_std),SAVE :: min_vegfrac=0.001 !- !!$ DS not used in the code ? ! Limit of air temperature for snow REAL(r_std),SAVE :: tsnow=273. !- ! Sets the amount above which only sublimation occures [Kg/m^2] REAL(r_std),SAVE :: snowcri=1.5 ! Critical value for computation of snow albedo [Kg/m^2] REAL(r_std),SAVE :: snowcri_alb=10. ! Lower limit of snow amount REAL(r_std),SAVE :: sneige !- ! The minimum wind REAL(r_std),SAVE :: min_wind = 0.1 ! bare soil roughness length (m) REAL(r_std),SAVE :: z0_bare = 0.01 ! ice roughness length (m) REAL(r_std),SAVE :: z0_ice = 0.001 !- ! Time constant of the albedo decay of snow REAL(r_std),SAVE :: tcst_snowa = cinq ! Maximum period of snow aging REAL(r_std),SAVE :: max_snow_age = 50._r_std ! Transformation time constant for snow (m) REAL(r_std),SAVE :: snow_trans = 0.3_r_std !- ! albedo of dead leaves, VIS+NIR REAL(r_std),DIMENSION(2),SAVE :: alb_deadleaf = (/ .12, .35/) ! albedo of ice, VIS+NIR REAL(r_std),DIMENSION(2),SAVE :: alb_ice = (/ .60, .20/) !!-------------------------------- !! SECHIBA specific parameters !!-------------------------------- ! !- ! condveg !- ! to get z0 from height REAL(r_std), SAVE :: z0_over_height = un/16. ! Magic number which relates the height to the displacement height. REAL(r_std), SAVE :: height_displacement = 0.75 !- ! diffuco !- INTEGER(i_std), SAVE :: nlai = 20 ! dimension de tableau ! used in diffuco_trans REAL(r_std), SAVE :: laimax = 12. REAL(r_std), SAVE :: xc4_1 = .83 REAL(r_std), SAVE :: xc4_2 = .93 !- ! hydrol. !- ! Allowed moisture above mcs (boundary conditions) REAL(r_std), SAVE :: dmcs = 0.002 ! Allowed moisture below mcr (boundary conditions) REAL(r_std), SAVE :: dmcr = 0.002 !- ! routing !- ! Parameter for the Kassel irrigation parametrization linked to the crops REAL(r_std), SAVE :: crop_coef = 1.5 !- ! slowproc !- REAL(r_std), SAVE :: clayfraction_default = 0.2 !----------------------------- ! STOMATE AND LPJ PARAMETERS !----------------------------- ! !- ! lpj_constraints !- ! longest sustainable time without regeneration (vernalization) REAL(r_std), SAVE :: too_long = 5. ! !- ! lpj_fire !- ! Time scale for memory of the fire index (days). Validated for one year in the DGVM. REAL(r_std), SAVE :: tau_fire = 30. ! Critical litter quantity for fire REAL(r_std), SAVE :: litter_crit = 200. ! !- ! lpj_light !- ! maximum total number of grass individuals in a closed canopy REAL(r_std), SAVE :: grass_mercy = 0.01 ! minimum fraction of trees that survive even in a closed canopy REAL(r_std), SAVE :: tree_mercy = 0.01 ! for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or ! to fpc of last time step (F)? LOGICAL, SAVE :: annual_increase = .TRUE. ! !- ! lpj_pftinout !- ! minimum availability REAL(r_std), SAVE :: min_avail = 0.01 ! !- ! stomate_alloc !- ! Do we try to reach a minimum reservoir even if we are severely stressed? LOGICAL, SAVE :: ok_minres = .TRUE. ! time (d) to attain the initial foliage using the carbohydrate reserve REAL(r_std), SAVE :: tau_leafinit = 10. ! maximum time (d) during which reserve is used (trees) REAL(r_std), SAVE :: reserve_time_tree = 30. ! maximum time (d) during which reserve is used (grasses) REAL(r_std), SAVE :: reserve_time_grass = 20. ! Standard root allocation REAL(r_std), SAVE :: R0 = 0.3 ! Standard sapwood allocation REAL(r_std), SAVE :: S0 = 0.3 ! only used in stomate_alloc ! Standard leaf allocation REAL(r_std), SAVE :: L0 ! Standard fruit allocation REAL(r_std), SAVE :: f_fruit = 0.1 ! fraction of sapwood allocation above ground (SHOULD BE CALCULATED !!!!) REAL(r_std), SAVE :: alloc_sap_above_tree = 0.5 REAL(r_std), SAVE :: alloc_sap_above_grass = 1.0 ! extrema of leaf allocation fraction REAL(r_std), SAVE :: min_LtoLSR = 0.2 REAL(r_std), SAVE :: max_LtoLSR = 0.5 ! scaling depth for nitrogen limitation (m) REAL(r_std), SAVE :: z_nitrogen = 0.2 ! !- ! stomate_data !- !!------------------------------- !! Parameters for the pipe model !!------------------------------ !- ! crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory) REAL(r_std),SAVE :: pipe_tune1 = 100.0 ! height=pipe_tune2 * diameter**pipe_tune3 REAL(r_std),SAVE :: pipe_tune2 = 40.0 REAL(r_std),SAVE :: pipe_tune3 = 0.5 ! needed for stem diameter REAL(r_std),SAVE :: pipe_tune4 = 0.3 ! Density REAL(r_std),SAVE :: pipe_density = 2.e5 ! one more SAVE REAL(r_std),SAVE :: pipe_k1 = 8.e3 ! !- ! Maximum tree establishment rate REAL(r_std),SAVE :: estab_max_tree = 0.12 ! Maximum grass establishment rate REAL(r_std),SAVE :: estab_max_grass = 0.12 ! initial density of individuals REAL(r_std),SAVE :: ind_0 = 0.02 ! For trees, minimum fraction of crown area occupied ! (due to its branches etc.) ! This means that only a small fraction of its crown area ! can be invaded by other trees. REAL(r_std),SAVE :: min_cover = 0.05 !- ! alpha's : ? REAL(r_std),SAVE :: alpha_grass = .5 REAL(r_std),SAVE :: alpha_tree = 1. !- ! maximum reference long term temperature (K) REAL(r_std),SAVE :: tlong_ref_max = 303.1 ! minimum reference long term temperature (K) REAL(r_std),SAVE :: tlong_ref_min = 253.1 ! !! LOGICAL !- ! Do we treat PFT expansion across a grid point after introduction? ! default = .FALSE. LOGICAL,SAVE :: treat_expansion = .FALSE. ! ! herbivores? LOGICAL,SAVE :: ok_herbivores = .FALSE. ! ! harvesting ? LOGICAL,SAVE :: harvest_agri = .TRUE. !!---------------------- !! climatic parameters !!--------------------- ! ! minimum precip, in mm/year REAL(r_std),SAVE :: precip_crit = 100. ! minimum gdd for establishment of saplings REAL(r_std),SAVE :: gdd_crit_estab = 150. ! critical fpc, needed for light competition and establishment REAL(r_std),SAVE :: fpc_crit = 0.95 !- ! fraction of GPP which is lost as growth respiration REAL(r_std),SAVE :: frac_growthresp = 0.28 ! !- ! mass ratio (heartwood+sapwood)/sapwood REAL(r_std), SAVE :: mass_ratio_heart_sap = 3. ! !!--------------------------------------------------------- ! time scales for phenology and other processes (in days) !!--------------------------------------------------------- ! REAL(r_std), SAVE :: tau_hum_month = 20. REAL(r_std), SAVE :: tau_hum_week = 7. REAL(r_std), SAVE :: tau_t2m_month = 20. REAL(r_std), SAVE :: tau_t2m_week = 7. REAL(r_std), SAVE :: tau_tsoil_month = 20. REAL(r_std), SAVE :: tau_soilhum_month = 20. REAL(r_std), SAVE :: tau_gpp_week = 7. REAL(r_std), SAVE :: tau_gdd = 40. REAL(r_std), SAVE :: tau_ngd = 50. REAL(r_std), SAVE :: coeff_tau_longterm = 3. ! used in stomate_data and in stomate_season REAL(r_std), SAVE :: tau_longterm ! !- ! stomate_litter !- ! scaling depth for soil activity (m) REAL(r_std), SAVE :: z_decomp = 0.2 ! !- ! stomate_lpj !- REAL(r_std), SAVE :: frac_turnover_daily = 0.55 ! !- ! stomate_npp !- ! maximum fraction of allocatable biomass used for maintenance respiration REAL(r_std), SAVE :: tax_max = 0.8 ! !- ! stomate_phenology !- ! take carbon from atmosphere if carbohydrate reserve too small? LOGICAL, SAVE :: always_init = .FALSE. ! minimum time (d) since last beginning of a growing season REAL(r_std), SAVE :: min_growthinit_time = 300. ! moisture availability above which moisture tendency doesn't matter REAL(r_std), SAVE :: moiavail_always_tree = 1.0 REAL(r_std), SAVE :: moiavail_always_grass = 0.6 ! monthly temp. above which temp. tendency doesn't matter REAL(r_std), SAVE :: t_always REAL(r_std), SAVE :: t_always_add = 10. ! !- ! stomate_season !- ! rapport maximal GPP/GGP_max pour dormance REAL(r_std), SAVE :: gppfrac_dormance = 0.2 ! minimum gpp considered as not "lowgpp" REAL(r_std), SAVE :: min_gpp_allowed = 0.3 ! tau (year) for "climatologic variables REAL(r_std), SAVE :: tau_climatology = 20 ! parameters for herbivore activity REAL(r_std), SAVE :: hvc1 = 0.019 REAL(r_std), SAVE :: hvc2 = 1.38 REAL(r_std), SAVE :: leaf_frac_hvc =.33 ! !- ! stomate_vmax !- ! offset (minimum relative vcmax) REAL(r_std), SAVE :: vmax_offset = 0.3 ! leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age) REAL(r_std), SAVE :: leafage_firstmax = 0.03 ! leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age) REAL(r_std), SAVE :: leafage_lastmax = 0.5 ! leaf age at which vmax attains its minimum (in fraction of critical leaf age) REAL(r_std), SAVE :: leafage_old = 1. !-------------------------- !-------------------------- ! ARRAYS-PARAMETERS !-------------------------- !-------------------------- !- ! condveg !- ! The correspondance table for the soil color numbers and their albedo ! REAL(r_std), DIMENSION(classnb) :: vis_dry = (/0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27/) REAL(r_std), DIMENSION(classnb) :: nir_dry = (/0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55/) REAL(r_std), DIMENSION(classnb) :: vis_wet = (/0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15/) REAL(r_std), DIMENSION(classnb) :: nir_wet = (/0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31/) ! ! Nathalie, introduction d'un albedo moyen, VIS+NIR ! Les valeurs suivantes correspondent a la moyenne des valeurs initiales ! REAL(stnd), DIMENSION(classnb) :: albsoil_vis = (/0.18, 0.165, 0.15, 0.135, 0.12, 0.105, 0.09, 0.075, 0.21/) ! REAL(stnd), DIMENSION(classnb) :: albsoil_nir = (/0.36, 0.33, 0.30, 0.27, 0.24, 0.21, 0.18, 0.15, 0.43/) ! les valeurs retenues accentuent le contraste entre equateur et Sahara. ! On diminue aussi l'albedo des deserts (tous sauf Sahara) REAL(r_std), DIMENSION(classnb) :: albsoil_vis = (/0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25/) REAL(r_std), DIMENSION(classnb) :: albsoil_nir = (/0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45/) !- ! lpj_fire !- ! What fraction of a burned plant compartment goes into the atmosphere ! (rest into litter) REAL(r_std), SAVE, DIMENSION(nparts) :: co2frac = (/ .95, .95, 0., 0.3, 0., 0., .95, .95 /) !- ! stomate_litter !- ! C/N ratio REAL(r_std), SAVE, DIMENSION(nparts) :: CN = 40.0 ! Lignine/C ratio of the different plant parts REAL(r_std), SAVE, DIMENSION(nparts) :: LC = (/ 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 /) ! corresponding to frac_soil(istructural,iactive,iabove) REAL(r_std), SAVE :: frac_soil_struct_aa = .55 ! corresponding to frac_soil(istructural,iactive,ibelow) REAL(r_std), SAVE :: frac_soil_struct_ab = .45 ! corresponding to frac_soil(istructural,islow,iabove) REAL(r_std), SAVE :: frac_soil_struct_sa = .7 ! corresponding to frac_soil(istructural,islow,ibelow) REAL(r_std), SAVE :: frac_soil_struct_sb = .7 ! corresponding to frac_soil(imetabolic,iactive,iabove) REAL(r_std), SAVE :: frac_soil_metab_aa = .45 ! corresponding to frac_soil(imetabolic,iactive,ibelow) REAL(r_std), SAVE :: frac_soil_metab_ab = .45 !- ! stomate_soilcarbon !- ! frac_carb_coefficients ! from active pool: depends on clay content ! correspnding to frac_carb(:,iactive,iactive) REAL(r_std), SAVE :: frac_carb_aa = 0.0 ! correspnding to frac_carb(:,iactive,ipassive) REAL(r_std), SAVE :: frac_carb_ap = 0.004 !frac_carb(;;iactive,islow) is computed in stomate_soilcarbon.f90 !- ! from slow pool ! correspnding to frac_carb(:,islow,islow) REAL(r_std), SAVE :: frac_carb_ss = 0.0 ! correspnding to frac_carb(:,islow,iactive) REAL(r_std), SAVE :: frac_carb_sa = .42 ! correspnding to frac_carb(:,islow,ipassive) REAL(r_std), SAVE :: frac_carb_sp = .03 !- ! from passive pool ! correspnding to frac_carb(:,ipassive,ipassive) REAL(r_std), SAVE :: frac_carb_pp = .0 ! correspnding to frac_carb(:,ipassive,iactive) REAL(r_std), SAVE :: frac_carb_pa = .45 ! correspnding to frac_carb(:,ipassive,islow) REAL(r_std), SAVE :: frac_carb_ps = .0 !---------------------------------------- !--------------------------------------- ! COEFFICIENTS OF EQUATIONS !------------------------------------- !--------------------------------------- !--------- ! SECHIBA !--------- !- ! diffuco !- REAL(r_std),PARAMETER :: Tetens_1 = 0.622 REAL(r_std),PARAMETER :: Tetens_2 = 0.378 REAL(r_std),PARAMETER :: std_ci_frac = 0.667 REAL(r_std),PARAMETER :: alpha_j = 0.8855 REAL(r_std),PARAMETER :: curve_assim = 0.7 REAL(r_std),PARAMETER :: WJ_coeff1 = 4.5 REAL(r_std),PARAMETER :: WJ_coeff2 = 10.5 REAL(r_std),PARAMETER :: Vc_to_Rd_ratio = 0.011 REAL(r_std),PARAMETER :: O2toCO2_stoechio = 1.6 REAL(r_std),PARAMETER :: mmol_to_m_1 = 0.0244 REAL(r_std),PARAMETER :: RG_to_PAR = 0.5 REAL(r_std),PARAMETER :: W_to_mmol = 4.6 ! W_to_mmol * RG_to_PAR = 2.3 ! REAL(r_std), SAVE :: lai_level_depth = .15 REAL(r_std), SAVE :: x1_coef = 0.177 REAL(r_std), SAVE :: x1_Q10 = 0.069 REAL(r_std), SAVE :: quantum_yield = 0.092 REAL(r_std), SAVE :: kt_coef = 0.7 REAL(r_std), SAVE :: kc_coef = 39.09 REAL(r_std), SAVE :: Ko_Q10 = .085 REAL(r_std), SAVE :: Oa = 210000. REAL(r_std), SAVE :: Ko_coef = 2.412 REAL(r_std), SAVE :: CP_0 = 42. REAL(r_std), SAVE :: CP_temp_coef = 9.46 REAL(r_std), SAVE :: CP_temp_ref = 25. ! REAL(r_std), SAVE, DIMENSION(2) :: rt_coef = (/ 0.8, 1.3 /) REAL(r_std), SAVE, DIMENSION(2) :: vc_coef = (/ 0.39, 0.3 /) ! ! coefficients of the polynome of degree 5 used inthe equation of coeff_dew_veg REAL(r_std), SAVE, DIMENSION(6) :: dew_veg_poly_coeff = & & (/ 0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017 /) !--------- ! LPJ !--------- !- ! lpj_crown !- REAL(r_std), SAVE :: pipe_tune_exp_coeff = 1.6 ! !- ! lpj_establish !- REAL(r_std), SAVE :: establish_scal_fact = 15. REAL(r_std), SAVE :: fpc_crit_max = .075 REAL(r_std), SAVE :: fpc_crit_min= .05 ! !- ! lpj_fire !- REAL(r_std), SAVE, DIMENSION(3) :: bcfrac_coeff = (/ .3, 1.3, 88.2 /) REAL(r_std), SAVE, DIMENSION(4) :: firefrac_coeff = (/ 0.45, 0.8, 0.6, 0.13 /) ! !- ! lpj_gap !- REAL(r_std), SAVE :: availability_fact = 0.02 REAL(r_std), SAVE :: vigour_ref = 0.17 REAL(r_std), SAVE :: vigour_coeff = 70. !- ! lpj_pftinout !- REAL(r_std), SAVE :: RIP_time_min = 1.25 REAL(r_std), SAVE :: npp_longterm_init = 10. REAL(r_std), SAVE :: everywhere_init = 0.05 ! !--------- ! STOMATE !--------- !- ! stomate_alloc !- REAL(r_std), PARAMETER :: max_possible_lai = 10. REAL(r_std), PARAMETER :: Nlim_Q10 = 10. ! REAL(r_std), SAVE :: lai_max_to_happy = 0.5 REAL(r_std), SAVE :: Nlim_tref = 25. ! !- ! stomate_data !- REAL(r_std), SAVE :: bm_sapl_carbres = 5. REAL(r_std), SAVE :: bm_sapl_sapabove = 0.5 REAL(r_std), SAVE :: bm_sapl_heartabove = 2. REAL(r_std), SAVE :: bm_sapl_heartbelow = 2. REAL(r_std), SAVE :: init_sapl_mass_leaf_nat = 0.1 REAL(r_std), SAVE :: init_sapl_mass_leaf_agri = 1. REAL(r_std), SAVE :: init_sapl_mass_carbres = 5. REAL(r_std), SAVE :: init_sapl_mass_root = 0.1 REAL(r_std), SAVE :: init_sapl_mass_fruit = 0.3 REAL(r_std), SAVE :: cn_sapl_init = 0.5 REAL(r_std), SAVE :: migrate_tree = 10.*1.E3 REAL(r_std), SAVE :: migrate_grass = 10.*1.E3 REAL(r_std), SAVE :: lai_initmin_tree = 0.3 REAL(r_std), SAVE :: lai_initmin_grass = 0.1 REAL(r_std), SAVE, DIMENSION(2) :: dia_coeff = (/ 4., 0.5 /) REAL(r_std), SAVE, DIMENSION(2) :: maxdia_coeff =(/ 100., 0.01/) REAL(r_std), SAVE, DIMENSION(4) :: bm_sapl_leaf = (/ 4., 4., .8, 5./) ! !- ! stomate_litter !- REAL(r_std), PARAMETER :: Q10 = 10. ! REAL(r_std), SAVE :: metabolic_ref_frac = 0.85 REAL(r_std), SAVE :: metabolic_LN_ratio = 0.018 REAL(r_std), SAVE :: tau_metabolic = .066 REAL(r_std), SAVE :: tau_struct = .245 REAL(r_std), SAVE :: soil_Q10 = .69 != ln 2 REAL(r_std), SAVE :: tsoil_ref = 30. REAL(r_std), SAVE :: litter_struct_coef = 3. REAL(r_std), SAVE, DIMENSION(3) :: moist_coeff = (/ 1.1, 2.4, 0.29 /) ! !- ! stomate_phenology !- REAL(r_std), SAVE :: gddncd_ref = 603. REAL(r_std), SAVE :: gddncd_curve = 0.0091 REAL(r_std), SAVE :: gddncd_offset = 64. ! !- ! stomate_prescribe !- REAL(r_std), SAVE :: cn_tree = 4. REAL(r_std), SAVE :: bm_sapl_rescale = 40. ! !- ! stomate_resp !- REAL(r_std), SAVE :: maint_resp_min_vmax = 0.3 REAL(r_std), SAVE :: maint_resp_coeff = 1.4 ! !- ! stomate_season !- REAL(r_std), SAVE :: ncd_max_year = 3. REAL(r_std), SAVE :: gdd_threshold = 5. REAL(r_std), SAVE :: green_age_ever = 2. REAL(r_std), SAVE :: green_age_dec = 0.5 !- ! stomate_soilcarbon !- REAL(r_std), SAVE :: active_to_pass_clay_frac = .68 !residence times in carbon pools (days) REAL(r_std), SAVE :: carbon_tau_iactive = .149 REAL(r_std), SAVE :: carbon_tau_islow = 5.48 REAL(r_std), SAVE :: carbon_tau_ipassive = 241. ! REAL(r_std), SAVE, DIMENSION(3) :: flux_tot_coeff = (/ 1.2, 1.4, .75/) ! !- ! stomate_turnover !- REAL(r_std), SAVE :: new_turnover_time_ref = 20. REAL(r_std), SAVE :: dt_turnover_time = 10. REAL(r_std), SAVE :: leaf_age_crit_tref = 20. REAL(r_std), SAVE, DIMENSION(3) :: leaf_age_crit_coeff = (/ 1.5, 0.75, 10./) !************************************************************** CONTAINS ! Subroutine called for getin the new parameters values used in sechiba ! SUBROUTINE getin_sechiba_parameters IMPLICIT NONE ! first call LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN !!$ CALL getin('DIAG_QSAT',diag_qsat) ! CALL getin('QWILT',qwilt) CALL getin('MIN_RESDIS',min_resdis) CALL getin('MIN_DRAIN',min_drain) CALL getin('MAX_DRAIN',max_drain) CALL getin('EXP_DRAIN',exp_drain) CALL getin('MX_EAU_EAU',mx_eau_eau) CALL getin('RSOL_CSTE',rsol_cste) CALL getin('HCRIT_LITTER',hcrit_litter) !- CALL getin('SOILTYPE_DEFAULT',soiltype_default) !- CALL getin('MAXMASS_GLACIER',maxmass_glacier) CALL getin('MIN_VEGFRAC',min_vegfrac) !- CALL getin('SNOWCRI',snowcri) !- CALL getin('SNOWCRI_ALB',snowcri_alb) CALL getin('MIN_WIND',min_wind) CALL getin('Z0_BARE',z0_bare) CALL getin('Z0_ICE',z0_ice) CALL getin('TCST_SNOWA',tcst_snowa) CALL getin('MAX_SNOW_AGE',max_snow_age) CALL getin('SNOW_TRANS',snow_trans) CALL getin('ALB_DEADLEAF',alb_deadleaf) CALL getin('ALB_ICE',alb_ice) !- CALL getin('Z0_OVER_HEIGHT',z0_over_height) CALL getin('HEIGHT_DISPLACEMENT',height_displacement) !- CALL getin('NLAI',nlai) CALL getin('LAIMAX',laimax) CALL getin('XC4_1',xc4_1) CALL getin('XC4_2',xc4_2) !- CALL getin('DMCS',dmcs) CALL getin('DMCR',dmcr) !- CALL getin('VIS_DRY',vis_dry) CALL getin('NIR_DRY',nir_dry) CALL getin('VIS_WET',vis_wet) CALL getin('NIR_WET',nir_wet) CALL getin('ALBSOIL_VIS',albsoil_vis) CALL getin('ALBSOIL_NIR',albsoil_nir) !- CALL getin('CLAYFRACTION_DEFAULT',clayfraction_default) ! CALL getin('DEW_VEG_POLY_COEFF',dew_veg_poly_coeff) first_call =.FALSE. ENDIF END SUBROUTINE getin_sechiba_parameters !********************************************************* ! Subroutine called only if river_routing is activated SUBROUTINE getin_routing_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN CALL getin('CROP_COEF',crop_coef) first_call =.FALSE. ENDIF END SUBROUTINE getin_routing_parameters !******************************************************* ! Subroutine called only if hydrol_cwrr is activated SUBROUTINE getin_hydrol_cwrr_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN CALL getin('W_TIME',w_time) CALL getin('NVAN',nvan) CALL getin('AVAN',avan) CALL getin('MCR',mcr) CALL getin('MCS',mcs) CALL getin('KS',ks) CALL getin('PCENT',pcent) CALL getin('FREE_DRAIN_MAX',free_drain_max) CALL getin('MCF',mcf) CALL getin('MCW',mcw) CALL getin('MC_AWET',mc_awet) first_call =.FALSE. ENDIF END SUBROUTINE getin_hydrol_cwrr_parameters !-------------------------------------------- ! Subroutine called only if ok_co2 is activated ! only for diffuco_trans_co2 SUBROUTINE getin_co2_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN CALL getin('LAI_LEVEL_DEPTH',lai_level_depth) CALL getin('X1_COEF',x1_coef) CALL getin('X1_Q10',x1_Q10) CALL getin('QUANTUM_YIELD',quantum_yield) CALL getin('KT_COEF',kt_coef) CALL getin('KC_COEF',kc_coef) CALL getin('KO_Q10',Ko_Q10) CALL getin('OA',Oa) CALL getin('KO_COEF',Ko_coef) CALL getin('CP_0',CP_0) CALL getin('CP_TEMP_COEF',cp_temp_coef) CALL getin('CP_TEMP_REF',cp_temp_ref) CALL getin('RT_COEF',rt_coef) CALL getin('VC_COEF',vc_coef) first_call =.FALSE. ENDIF END SUBROUTINE getin_co2_parameters !********************************************************** ! Subroutine called only if stomate is activated SUBROUTINE getin_stomate_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN CALL getin('TOO_LONG',too_long) !- CALL getin('TAU_FIRE',tau_fire) CALL getin('LITTER_CRIT',litter_crit) !- CALL getin('OK_MINRES',ok_minres) CALL getin('TAU_LEAFINIT', tau_leafinit) CALL getin('RESERVE_TIME_TREE',reserve_time_tree) CALL getin('RESERVE_TIME_GRASS',reserve_time_grass) CALL getin('R0',R0) CALL getin('S0',S0) CALL getin('F_FRUIT',f_fruit) CALL getin('ALLOC_SAP_ABOVE_TREE',alloc_sap_above_tree) CALL getin('ALLOC_SAP_ABOVE_GRASS',alloc_sap_above_grass) CALL getin('MIN_LTOLSR',min_LtoLSR) CALL getin('MAX_LTOLSR',max_LtoLSR) CALL getin('Z_NITROGEN',z_nitrogen) !- CALL getin('PIPE_TUNE1',pipe_tune1) CALL getin('PIPE_TUNE2',pipe_tune2) CALL getin('PIPE_TUNE3',pipe_tune3) CALL getin('PIPE_TUNE4',pipe_tune4) CALL getin('PIPE_DENSITY',pipe_density) CALL getin('PIPE_K1',pipe_k1) CALL getin('ESTAB_MAX_TREE',estab_max_tree) CALL getin('ESTAB_MAX_GRASS',estab_max_grass) CALL getin('IND_0',ind_0) CALL getin('MIN_COVER',min_cover) CALL getin('PRECIP_CRIT',precip_crit) CALL getin('GDD_CRIT_ESTAB',gdd_crit_estab) CALL getin('FPC_CRIT',fpc_crit) CALL getin('FRAC_GROWTHRESP',frac_growthresp) CALL getin('ALPHA_GRASS',alpha_grass) CALL getin('ALPHA_TREE',alpha_tree) CALL getin('TLONG_REF_MAX',tlong_ref_max) CALL getin('TLONG_REF_MIN',tlong_ref_min) !- CALL getin('MASS_RATIO_HEART_SAP',mass_ratio_heart_sap) CALL getin('TAU_HUM_MONTH',tau_hum_month) CALL getin('TAU_HUM_WEEK',tau_hum_week) CALL getin('TAU_T2M_MONTH',tau_t2m_month) CALL getin('TAU_T2M_WEEK',tau_t2m_week) CALL getin('TAU_TSOIL_MONTH',tau_tsoil_month) CALL getin('TAU_SOILHUM_MONTH',tau_soilhum_month) CALL getin('TAU_GPP_WEEK',tau_gpp_week) CALL getin('TAU_GDD',tau_gdd) CALL getin('TAU_NGD',tau_ngd) CALL getin('COEFF_TAU_LONGTERM',coeff_tau_longterm) ! CALL getin('FRAC_TURNOVER_DAILY',frac_turnover_daily) !- CALL getin('Z_DECOMP',z_decomp) !- CALL getin('TAX_MAX',tax_max) !- CALL getin('ALWAYS_INIT',always_init) CALL getin('MIN_GROWTHINIT_TIME',min_growthinit_time) CALL getin('MOIAVAIL_ALWAYS_TREE',moiavail_always_tree) CALL getin('MOIAVAIL_ALWAYS_GRASS',moiavail_always_grass) CALL getin('T_ALWAYS_ADD',t_always_add) !- CALL getin('VMAX_OFFSET',vmax_offset) CALL getin('LEAFAGE_FIRSTMAX',leafage_firstmax) CALL getin('LEAFAGE_LASTMAX',leafage_lastmax) CALL getin('LEAFAGE_OLD',leafage_old) !- CALL getin('GPPFRAC_DORMANCE',gppfrac_dormance) CALL getin('MIN_GPP_ALLOWED',min_gpp_allowed) CALL getin('TAU_CLIMATOLOGY',tau_climatology) CALL getin('HVC1',hvc1) CALL getin('HVC2',hvc2) CALL getin('LEAF_FRAC_HVC',leaf_frac_hvc) !- CALL getin('CO2FRAC',co2frac) CALL getin('CN',CN) CALL getin('LC',LC) !- CALL getin('FRAC_SOIL_STRUCT_AA',frac_soil_struct_aa) CALL getin('FRAC_SOIL_STRUCT_AB',frac_soil_struct_ab) CALL getin('FRAC_SOIL_STRUCT_SA',frac_soil_struct_sa) CALL getin('FRAC_SOIL_STRUCT_SB',frac_soil_struct_sb) CALL getin('FRAC_SOIL_METAB_AA',frac_soil_metab_aa) CALL getin('FRAC_SOIL_METAB_AB',frac_soil_metab_ab) !- CALL getin('FRAC_CARB_AA',frac_carb_aa) CALL getin('FRAC_CARB_AP',frac_carb_ap) CALL getin('FRAC_CARB_SS',frac_carb_ss) CALL getin('FRAC_CARB_SA',frac_carb_sa) CALL getin('FRAC_CARB_SP',frac_carb_sp) CALL getin('FRAC_CARB_PP',frac_carb_pp) CALL getin('FRAC_CARB_PA',frac_carb_pa) CALL getin('FRAC_CARB_PS',frac_carb_ps) !--------------------------------------- ! COEFFICIENTS OF EQUATIONS !------------------------------------- ! !- CALL getin('BCFRAC_COEFF',bcfrac_coeff) CALL getin('FIREFRAC_COEFF',firefrac_coeff) !- CALL getin('AVAILABILITY_FACT', availability_fact) CALL getin('VIGOUR_REF',vigour_ref) CALL getin('VIGOUR_COEFF',vigour_coeff) !- CALL getin('RIP_TIME_MIN',RIP_time_min) CALL getin('NPP_LONGTERM_INIT',npp_longterm_init) CALL getin('EVERYWHERE_INIT',everywhere_init) ! !- CALL getin('LAI_MAX_TO_HAPPY',lai_max_to_happy) CALL getin('NLIM_TREF',Nlim_tref) !- CALL getin('BM_SAPL_CARBRES',bm_sapl_carbres) CALL getin('BM_SAPL_SAPABOVE',bm_sapl_sapabove) CALL getin('BM_SAPL_HEARTABOVE',bm_sapl_heartabove) CALL getin('BM_SAPL_HEARTBELOW',bm_sapl_heartbelow) CALL getin('INIT_SAPL_MASS_LEAF_NAT',init_sapl_mass_leaf_nat) CALL getin('INIT_SAPL_MASS_LEAF_AGRI',init_sapl_mass_leaf_agri) CALL getin('INIT_SAPL_MASS_CARBRES',init_sapl_mass_carbres) CALL getin('INIT_SAPL_MASS_ROOT',init_sapl_mass_root) CALL getin('INIT_SAPL_MASS_FRUIT',init_sapl_mass_fruit) CALL getin('CN_SAPL_INIT',cn_sapl_init) CALL getin('MIGRATE_TREE',migrate_tree) CALL getin('MIGRATE_GRASS',migrate_grass) CALL getin('MAXDIA_COEFF',maxdia_coeff) CALL getin('LAI_INITMIN_TREE',lai_initmin_tree) CALL getin('LAI_INITMIN_GRASS',lai_initmin_grass) CALL getin('DIA_COEFF',dia_coeff) CALL getin('MAXDIA_COEFF',maxdia_coeff) CALL getin('BM_SAPL_LEAF',bm_sapl_leaf) !- CALL getin('METABOLIC_REF_FRAC',metabolic_ref_frac) CALL getin('METABOLIC_LN_RATIO',metabolic_LN_ratio) CALL getin('TAU_METABOLIC',tau_metabolic) CALL getin('TAU_STRUCT',tau_struct) CALL getin('SOIL_Q10',soil_Q10) CALL getin('TSOIL_REF',tsoil_ref) CALL getin('LITTER_STRUCT_COEF',litter_struct_coef) CALL getin('MOIST_COEFF',moist_coeff) !- CALL getin('GDDNCD_REF',gddncd_ref) CALL getin('GDDNCD_CURVE',gddncd_curve) CALL getin('GDDNCD_OFFSET',gddncd_offset) !- CALL getin('CN_TREE',cn_tree) CALL getin('BM_SAPL_RESCALE',bm_sapl_rescale) !- CALL getin('MAINT_RESP_MIN_VMAX',maint_resp_min_vmax) CALL getin('MAINT_RESP_COEFF',maint_resp_coeff) !- CALL getin('NCD_MAX_YEAR',ncd_max_year) CALL getin('GDD_THRESHOLD',gdd_threshold) CALL getin('GREEN_AGE_EVER',green_age_ever) CALL getin('GREEN_AGE_DEC',green_age_dec) !- CALL getin('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac) CALL getin('CARBON_TAU_IACTIVE',carbon_tau_iactive) CALL getin('CARBON_TAU_ISLOW',carbon_tau_islow) CALL getin('CARBON_TAU_IPASSIVE',carbon_tau_ipassive) CALL getin('FLUX_TOT_COEFF',flux_tot_coeff) !- CALL getin('NEW_TURNOVER_TIME_REF',new_turnover_time_ref) CALL getin('DT_TURNOVER_TIME',dt_turnover_time) CALL getin('LEAF_AGE_CRIT_TREF',leaf_age_crit_tref) CALL getin('LEAF_AGE_CRIT_COEFF',leaf_age_crit_coeff) first_call = .FALSE. ENDIF END SUBROUTINE getin_stomate_parameters !****************************************** SUBROUTINE getin_dgvm_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN CALL getin('PIPE_TUNE_EXP_COEFF',pipe_tune_exp_coeff) ! CALL getin('ESTABLISH_SCAL_FACT',establish_scal_fact) CALL getin('FPC_CRIT_MAX',fpc_crit_max) CALL getin('FPC_CRIT_MIN',fpc_crit_min) ! CALL getin('GRASS_MERCY',grass_mercy) CALL getin('TREE_MERCY',tree_mercy) CALL getin('ANNUAL_INCREASE',annual_increase) ! CALL getin('MIN_AVAIL',min_avail) CALL getin('RIP_TIME_MIN',RIP_time_min) CALL getin('NPP_LONGTERM_INIT',npp_longterm_init) CALL getin('EVERYWHERE_INIT',everywhere_init) first_call = .FALSE. ENDIF END SUBROUTINE getin_dgvm_parameters !-------------------- END MODULE constantes