!$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 parallel !- IMPLICIT NONE !- !------------------------- ! ORCHIDEE CONSTANTS !------------------------ !---------------- ! Global !---------------- !- ! 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. !- ! 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_int = 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 !--------------------------------------- !------------- ! condveg !------------- ! index for visible albedo INTEGER(i_std), PARAMETER :: ivis = 1 ! index for near infrared albedo INTEGER(i_std), PARAMETER :: inir = 2 !---------------- ! 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 ! ! transformation between types of surface (DS : not used in the code?) INTEGER(i_std),PARAMETER :: ito_natagri = 1 INTEGER(i_std),PARAMETER :: ito_total = 2 !------------------------------ ! MATH AND PHYSICS CONSTANTS !------------------------------ !------------------------------------ ! 1 . Maths and numerical constants !------------------------------------ ! pi REAL(r_std), PARAMETER :: pi = 4.*ATAN(1.) ! e REAL(r_std),PARAMETER :: euler = EXP(1.) ! previously 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) ! comment : ! Earth radius ~= Equatorial radius ! The Earth's equatorial radius a, or semi-major axis, is the distance from its center to the equator and equals 6,378.1370 km. ! The equatorial radius is often used to compare Earth with other planets. REAL(r_std), PARAMETER :: R_Earth = 6378000. !The meridional mean is well approximated by the semicubic mean of the two axe yielding 6367.4491 km ! or less accurately by the quadratic mean of the two axes about 6,367.454 km ! or even just the mean of the two axes about 6,367.445 km. !- ! 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 !------------------------! ! SECHIBA PARAMETERS ! !------------------------! ! DS Maybe should I move these constants in the modules they belong !- ! Specific parameters for the CWRR hydrology module !- ! ! 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 !- ! 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 !-----------! ! Global ! !-----------! ! The minimum wind REAL(r_std),SAVE :: min_wind = 0.1 ! Sets the amount above which only sublimation occures [Kg/m^2] REAL(r_std),SAVE :: snowcri=1.5 ! Transforms leaf area index into size of interception reservoir REAL(r_std),SAVE :: qsintcst = 0.1 ! Total depth of soil reservoir (for hydrolc) REAL(r_std),SAVE :: dpu_cste = 2.0_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 /) ! ! FLAGS ACTIVATING SUB-MODELS ! LOGICAL, SAVE :: doirrigation = .FALSE. LOGICAL, SAVE :: dofloodplains = .FALSE. ! 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. ! constant moratlity LOGICAL,SAVE :: lpj_gap_const_mort = .TRUE. ! flag that disable fire LOGICAL, SAVE :: disable_fire = .FALSE. ! ! Configuration vegetation ! ! allow agricultural PFTs LOGICAL, SAVE :: agriculture = .TRUE. LOGICAL, SAVE :: impveg = .FALSE. LOGICAL, SAVE :: impsoilt = .FALSE. ! Land cover change flag LOGICAL,SAVE :: lcchange=.FALSE. ! Lai Map LOGICAL, SAVE :: read_lai = .FALSE. ! Old Lai Map interpolation LOGICAL, SAVE :: old_lai = .FALSE. ! Old veget Map interpolation LOGICAL, SAVE :: old_veget = .FALSE. ! Land Use LOGICAL, SAVE :: land_use = .FALSE. ! To change LAND USE file in a run. LOGICAL, SAVE :: veget_reinit=.FALSE. ! ! Parameters used by both hydrology models ! ! 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 ! Lower limit of snow amount REAL(r_std),SAVE :: sneige ! The maximum mass (kg/m^2) of a glacier. REAL(r_std),SAVE :: maxmass_glacier = 3000. ! Maximum quantity of water (Kg/M3) REAL(r_std),SAVE :: mx_eau_eau = 150. ! UNKNOW ! Is veget_ori array stored in restart file !!$! DS: Where is it used ? ! LOGICAL,PARAMETER :: ldveget_ori_on_restart = .TRUE. !- !!$! DS not used in the code ? ! Limit of air temperature for snow REAL(r_std),SAVE :: tsnow=273. !-------------! ! condveg.f90 ! !-------------! ! 1. Scalar ! 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 ! 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 = 5.0 ! Critical value for computation of snow albedo [Kg/m^2] REAL(r_std),SAVE :: snowcri_alb=10. ! In case we wish a fxed snow albedo REAL(r_std), SAVE :: fixed_snow_albedo = undef_sechiba ! Switch to old (albedo bare depend on soil wetness) or new one (mean of soilalb) LOGICAL, SAVE :: alb_bare_model = .FALSE. ! Choice on the surface parameters LOGICAL, SAVE :: impaze = .FALSE. ! Chooses the method for the z0 average LOGICAL, SAVE :: z0cdrag_ave=.FALSE. ! Roughness used to initialize the scheme REAL(r_std), SAVE :: z0_scal = 0.15_r_std ! Height to displace the surface from the zero wind height. REAL(r_std), SAVE :: roughheight_scal = zero ! Surface emissivity used to initialize the scheme REAL(r_std), SAVE :: emis_scal = un ! 2. Arrays ! 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/) ! albedo values need for initialisation REAL(r_std),DIMENSION(2),SAVE :: albedo_scal = (/ 0.25_r_std, 0.25_r_std /) ! 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/) ! 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/) !-------------! ! diffuco.f90 ! !-------------! ! 1. Scalar INTEGER(i_std), SAVE :: nlai = 20 ! used in diffuco_trans REAL(r_std), SAVE :: laimax = 12. REAL(r_std), SAVE :: xc4_1 = .83 REAL(r_std), SAVE :: xc4_2 = .93 ! Set to .TRUE. if you want q_cdrag coming from GCM LOGICAL,SAVE :: ldq_cdrag_from_gcm = .FALSE. ! 2; Arrays ! 3. Coefficients of equations 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 /) !-------------! ! hydrolc.f90 ! !-------------! ! 1. Scalar ! ! Wilting point (Has a numerical role for the moment) REAL(r_std),SAVE :: qwilt = 5.0 ! 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 !- ! 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 ! do horizontal diffusion? LOGICAL, SAVE :: ok_hdiff = .FALSE. !-------------! ! hydrol.f90 ! !-------------! ! 1. Scalar ! 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 ! 2. Arrays !- ! 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 /) !- ! 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 /) !-------------! ! routing.f90 ! !-------------! ! 1. Scalar ! Parameter for the Kassel irrigation parametrization linked to the crops REAL(r_std), SAVE :: crop_coef = 1.5 !--------------! ! slowproc.f90 ! !--------------! ! 1. Scalar REAL(r_std), SAVE :: clayfraction_default = 0.2 ! Minimal fraction of mesh a vegetation type can occupy REAL(r_std),SAVE :: min_vegfrac=0.001 ! 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 ! first year for landuse INTEGER(i_std) , SAVE :: veget_year_orig = 0 ! DS which is the default value? I found also :: veget_year_orig=282 ! only needed for an initial LAI if there is no restart file REAL(r_std), SAVE :: stempdiag_bid = 280. ! 2. Arrays ! 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 /) !-----------------------------! ! STOMATE AND LPJ PARAMETERS ! !-----------------------------! !- ! stomate_alloc !- REAL(r_std), PARAMETER :: max_possible_lai = 10. REAL(r_std), PARAMETER :: Nlim_Q10 = 10. !- ! stomate_litter !- REAL(r_std), PARAMETER :: Q10 = 10. ! ! DS 31/03/2011 test new organization ! List of Externalized Parameters by modules !----------------------! ! lpj_constraints.f90 ! !----------------------! ! 1. Scalar ! longest sustainable time without regeneration (vernalization) REAL(r_std), SAVE :: too_long = 5. !--------------------! ! lpj_establish.f90 ! !--------------------! ! 1. Scalar ! 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 ! 3. Coefficients of equations 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.f90 ! !---------------! ! 1. Scalar ! 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. ! 2. Arrays ! 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 /) ! 3. Coefficients of equations 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.f90 ! !--------------! ! 1. Scalar ! DS 15/06/2011 : the name of the parameter constant_mortality was replaced by its keyword !!$ ! which kind of mortality !!$ LOGICAL, SAVE :: constant_mortality = .TRUE. ! 3. Coefficients of equations REAL(r_std), SAVE :: availability_fact = 0.02 REAL(r_std), SAVE :: vigour_ref = 0.17 REAL(r_std), SAVE :: vigour_coeff = 70. !----------------! ! lpj_light.f90 ! !----------------! ! 1. Scalar ! 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. ! 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 !------------------! ! lpj_pftinout.f90 ! !------------------! ! 1. Scalar ! minimum availability REAL(r_std), SAVE :: min_avail = 0.01 ! initial density of individuals REAL(r_std),SAVE :: ind_0 = 0.02 ! 2. Arrays ! 3. Coefficients of equations 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_alloc.f90 ! !-------------------! ! 1. Scalar ! 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 ! 2. Arrays ! 3. Coefficients of equations REAL(r_std), SAVE :: lai_max_to_happy = 0.5 REAL(r_std), SAVE :: Nlim_tref = 25. !------------------! ! stomate_data.f90 ! !------------------! ! 1. Scalar ! ! 1.1 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 ! pipe tune exponential coeff REAL(r_std), SAVE :: pipe_tune_exp_coeff = 1.6 ! ! 1.2 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 ! ! 1.3 sapling characteristics ! ! alpha's : ? REAL(r_std),SAVE :: alpha_grass = .5 REAL(r_std),SAVE :: alpha_tree = 1. ! mass ratio (heartwood+sapwood)/sapwood REAL(r_std), SAVE :: mass_ratio_heart_sap = 3. ! fraction of GPP which is lost as growth respiration REAL(r_std),SAVE :: frac_growthresp = 0.28 ! ! 1.4 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. REAL(r_std), SAVE :: tau_longterm ! 3. Coefficients of equations 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.f90 ! !--------------------! ! 1. Scalar ! scaling depth for soil activity (m) REAL(r_std), SAVE :: z_decomp = 0.2 ! 2. Arrays ! 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 ! 3. Coefficients of equations REAL(r_std), SAVE :: metabolic_ref_frac = 0.85 ! used by litter and soilcarbon 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_lpj.f90 ! !-----------------! ! 1. Scalar REAL(r_std), SAVE :: frac_turnover_daily = 0.55 !-----------------! ! stomate_npp.f90 ! !-----------------! ! 1. Scalar ! maximum fraction of allocatable biomass used for maintenance respiration REAL(r_std), SAVE :: tax_max = 0.8 !-----------------------! ! stomate_phenology.f90 ! !-----------------------! ! 1. Scalar ! 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. ! 3. Coefficients of equations REAL(r_std), SAVE :: gddncd_ref = 603. REAL(r_std), SAVE :: gddncd_curve = 0.0091 REAL(r_std), SAVE :: gddncd_offset = 64. !-----------------------! ! stomate_prescribe.f90 ! !-----------------------! ! 3. Coefficients of equations REAL(r_std), SAVE :: cn_tree = 4. REAL(r_std), SAVE :: bm_sapl_rescale = 40. !------------------! ! stomate_resp.f90 ! !------------------! ! 3. Coefficients of equations REAL(r_std), SAVE :: maint_resp_min_vmax = 0.3 REAL(r_std), SAVE :: maint_resp_coeff = 1.4 !------------------------! ! stomate_soilcarbon.f90 ! !------------------------! ! 2. Arrays ! 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 ! 3. Coefficients of equations 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.f90 ! !----------------------! ! 3.Coefficients of equations 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./) !------------------! ! stomate_vmax.f90 ! !------------------! ! 1. Scalar ! 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. !--------------------! ! stomate_season.f90 ! !--------------------! ! 1. Scalar ! 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 ! 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 ! 3. Coefficients of equations 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 CONTAINS SUBROUTINE activate_sub_models(ok_sechiba,ok_routing, ok_stomate) IMPLICIT NONE ! first call LOGICAL, SAVE :: first_call = .TRUE. ! input LOGICAL, INTENT(in) :: ok_sechiba LOGICAL, INTENT(in) :: ok_routing LOGICAL, INTENT(in) :: ok_stomate IF (first_call) THEN IF(ok_sechiba .AND. ok_routing) THEN !Config Key = DO_IRRIGATION !Config Desc = Should we compute an irrigation flux !Config Def = FALSE !Config Help = This parameters allows the user to ask the model !Config to compute an irigation flux. This performed for the !Config on very simple hypothesis. The idea is to have a good !Config map of irrigated areas and a simple function which estimates !Config the need to irrigate. CALL getin_p('DO_IRRIGATION', doirrigation) ! !Config Key = DO_FLOODPLAINS !Config Desc = Should we include floodplains !Config Def = FALSE !Config Help = This parameters allows the user to ask the model !Config to take into account the flood plains and return !Config the water into the soil moisture. It then can go !Config back to the atmopshere. This tried to simulate !Config internal deltas of rivers. CALL getin_p('DO_FLOODPLAINS', dofloodplains) ENDIF IF(ok_stomate) THEN !Config Key = HERBIVORES !Config Desc = herbivores allowed? !Config Def = n !Config Help = With this variable, you can determine !Config if herbivores are activated CALL getin_p('HERBIVORES', ok_herbivores) ! !Config Key = TREAT_EXPANSION !Config Desc = treat expansion of PFTs across a grid cell? !Config Def = n !Config Help = With this variable, you can determine !Config whether we treat expansion of PFTs across a !Config grid cell. CALL getin_p('TREAT_EXPANSION', treat_expansion) ! !Config Key = LPJ_GAP_CONST_MORT !Config Desc = prescribe mortality if not using DGVM? !Config Def = y !Config Help = set to TRUE if constant mortality is to be activated ! ignored if DGVM=true! CALL getin_p('LPJ_GAP_CONST_MORT', lpj_gap_const_mort) ! !Config Key = HARVEST_AGRI !Config Desc = Harvert model for agricol PFTs. !Config Def = y !Config Help = Compute harvest above ground biomass for agriculture. !Config Change daily turnover. CALL getin_p('HARVEST_AGRI', harvest_agri) ! !Config Key = FIRE_DISABLE !Config Desc = no fire allowed !Config Def = n !Config Help = With this variable, you can allow or not !Config the estimation of CO2 lost by fire CALL getin_p('FIRE_DISABLE', disable_fire) ENDIF ! ! Check consistency (see later) ! !!$ IF(.NOT.(ok_routing) .AND. (doirrigation .OR. dofloodplains)) THEN !!$ CALL ipslerr (2,'activate_sub_models', & !!$ & 'Problem :you tried to activate the irrigation and floodplains without activating the routing',& !!$ & 'Are you sure ?', & !!$ & '(check your parameters).') !!$ ENDIF !!$ IF(.NOT.(ok_stomate) .AND. (ok_herbivores .OR. treat_expansion .OR. lpj_gap_const_mort & !!$ & .OR. harvest_agri .OR. disable_fire)) THEN !!$ CALL ipslerr (2,'activate_sub_models', & !!$ & 'Problem : try to activate the following options : herbivory, treat_expansion, fire,',& !!$ & 'harvest_agri and constant mortality without stomate activated.',& !!$ & '(check your parameters).') !!$ ENDIF first_call =.FALSE. ENDIF END SUBROUTINE activate_sub_models ! != ! SUBROUTINE veget_config ! DS : this subroutine reads the flags previously in slowproc.f90 . As these parameters ! let the user to configure the vegetation, it is called veget_config. IMPLICIT NONE ! first call LOGICAL, SAVE :: first_call = .TRUE. IF (first_call) THEN !Config Key = AGRICULTURE !Config Desc = agriculture allowed? !Config Def = y !Config Help = With this variable, you can determine !Config whether agriculture is allowed ! CALL getin_p('AGRICULTURE', agriculture) ! !Config Key = IMPOSE_VEG !Config Desc = Should the vegetation be prescribed !Config Def = n !Config Help = This flag allows the user to impose a vegetation distribution !Config and its characterisitcs. It is espacially interesting for 0D !Config simulations. On the globe it does not make too much sense as !Config it imposes the same vegetation everywhere ! CALL getin_p('IMPOSE_VEG', impveg) IF(impveg) THEN !Config Key = IMPOSE_SOILT !Config Desc = Should the soil typ be prescribed !Config Def = n !Config If = IMPOSE_VEG !Config Help = This flag allows the user to impose a soil type distribution. !Config It is espacially interesting for 0D !Config simulations. On the globe it does not make too much sense as !Config it imposes the same soil everywhere CALL getin_p('IMPOSE_SOILT', impsoilt) ENDIF !Config Key = LAI_MAP !Config Desc = Read the LAI map !Config Def = n !Config Help = It is possible to read a 12 month LAI map which will !Config then be interpolated to daily values as needed. CALL getin_p('LAI_MAP',read_lai) IF(read_lai) THEN !Config Key = SLOWPROC_LAI_OLD_INTERPOL !Config Desc = Flag to use old "interpolation" of LAI !Config If = LAI_MAP !Config Def = FALSE !Config Help = If you want to recover the old (ie orchidee_1_2 branch) !Config "interpolation" of LAI map. CALL getin_p('SLOWPROC_LAI_OLD_INTERPOL',old_lai) ENDIF ! !Config Key = LAND_USE !Config Desc = Read a land_use vegetation map !Config Def = n !Config Help = pft values are needed, max time axis is 293 CALL getin_p('LAND_USE',land_use) IF(land_use) THEN !Config Key = VEGET_REINIT !Config Desc = booleen to indicate that a new LAND USE file will be used. !Config If = LAND_USE !Config Def = n !Config Help = The parameter is used to bypass veget_year count !Config Help and reinitialize it with VEGET_YEAR parameter. !Config Help Then it is possible to change LAND USE file. CALL getin_p('VEGET_REINIT', veget_reinit) ! !Config Key = LAND_COVER_CHANGE !Config Desc = treat land use modifications !Config If = LAND_USE !Config Def = y !Config Help = With this variable, you can use a Land Use map !Config to simulate anthropic modifications such as !Config deforestation. CALL getin_p('LAND_COVER_CHANGE', lcchange) ! !Config Key = VEGET_YEAR !Config Desc = Year of the land_use vegetation map to be read (0 == NO TIME AXIS) !Config If = LAND_USE !Config Def = 282 !Config Help = First year for landuse vegetation (2D map by pft). !Config Help If VEGET_YEAR == 0, this means there is no time axis. CALL getin_p('VEGET_YEAR', veget_year_orig) ENDIF IF(.NOT. impveg .AND. .NOT. land_use) THEN !Config Key = SLOWPROC_VEGET_OLD_INTERPOL !Config Desc = Flag to use old "interpolation" of vegetation map. !Config If = NOT IMPOSE_VEG and NOT LAND_USE !Config Def = FALSE !Config Help = If you want to recover the old (ie orchidee_1_2 branch) !Config "interpolation" of vegetation map. CALL getin_p('SLOWPROC_VEGET_OLD_INTERPOL',old_veget) ENDIF ! ! Check consistency ! ! 1. You have to activate agriculture and land_use IF ( .NOT. agriculture .AND. land_use ) THEN CALL ipslerr (2,'veget_config', & & 'Problem with agriculture desactivated and Land Use activated.',& & 'Are you sure ?', & & '(check your parameters).') ENDIF first_call = .FALSE. ENDIF !!$ ! DS : Add warning in case of a wrong configuration (need to be discussed) !!$ ! 2. !!$ IF (.NOT.(read_lai) .AND. old_lai) THEN !!$ CALL ipslerr (2,'veget_config', & !!$ & 'Problem with lai_map desactivated and old_lai activated.',& !!$ & 'Are you sure ?', & !!$ & '(check your parameters).') !!$ ENDIF !!$ !!$ ! 3. !!$ IF ((impveg .OR. land_use) .AND. old_veget) THEN !!$ CALL ipslerr (2,'veget_config', & !!$ & 'Problem : try to use the old interpolation with a land use map or in impose_veg.',& !!$ & 'Are you sure ?', & !!$ & '(check your parameters).') !!$ ENDIF !!$ !!$ ! 4. !!$ IF ( .NOT.(impveg) .AND. impsoilt) THEN !!$ CALL ipslerr (2,'veget_config', & !!$ & 'Problem : try to activate impose_soilt without activating impose_veg.',& !!$ & 'Are you sure ?', & !!$ & '(check your parameters).') !!$ ENDIF !!$ !!$ ! 5. !!$ IF (.NOT.(land_use) .AND. (veget_reinit)) THEN !!$ CALL ipslerr (2,'veget_config', & !!$ & 'Problem : try to use a land_use map without activating land_use.',& !!$ & 'Are you sure ?', & !!$ & '(check your parameters).') !!$ ENDIF !!$ !!$ ! 6. !!$ IF (.NOT.(land_use) .AND. lcchange) THEN !!$ CALL ipslerr (2,'veget_config', & !!$ & 'Problem : lcchange is activated without activating land_use.',& !!$ & 'Are you sure ?', & !!$ & '(check your parameters).') !!$ ENDIF END SUBROUTINE veget_config ! != ! SUBROUTINE getin_sechiba_parameters IMPLICIT NONE ! first call LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN ! Global : parameters used by many modules ! !Config Key = MAXMASS_GLACIER !Config Desc = !Config If = OK_SECHIBA or OK_CWRR !Config Def = 3000. !Config Help = !Config Units = [Kg/m^2] CALL getin_p('MAXMASS_GLACIER',maxmass_glacier) ! !Config Key = SNOWCRI !Config Desc = !Config If = OK_SECHIBA or OK_CWRR !Config Def = 1.5 !Config Help = !Config Units = [Kg/m^2] CALL getin_p('SNOWCRI',snowcri) ! !Interception reservoir coefficient !Config Key = SECHIBA_QSINT !Config Desc = Interception reservoir coefficient !Config If = OK_SECHIBA !Config Def = 0.1 !Config Help = Transforms leaf area index into size of interception reservoir !Config for slowproc_derivvar or stomate !Config Units = meters [m] CALL getin_p('SECHIBA_QSINT', qsintcst) ! !Config Key = HYDROL_SOIL_DEPTH !Config Desc = Total depth of soil reservoir !Config If = OK_SECHIBA !Config Def = 2. !Config Help = !Config Units = meters [m] CALL getin_p("HYDROL_SOIL_DEPTH", dpu_cste) ! ! !Config Key = MIN_WIND !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.1 !Config Help = !Config Units = [m/s] ? CALL getin_p('MIN_WIND',min_wind) ! !Config Key = MAX_SNOW_AGE !Config Desc = Maximum period of snow aging !Config If = OK_SECHIBA !Config Def = 50. !Config Help = !Config Units = CALL getin_p('MAX_SNOW_AGE',max_snow_age) ! !Config Key = SNOW_TRANS !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.3 !Config Help = !Config Units = meters [m] CALL getin_p('SNOW_TRANS',snow_trans) ! !Config Key = MX_EAU_EAU !Config Desc = !Config If = OK_SECHIBA !Config Def = 150. !Config Help = !Config Units = [Kg/M3] CALL getin_p('MX_EAU_EAU',mx_eau_eau) !- ! condveg !- ! !Config Key = Z0_OVER_HEIGHT !Config Desc = to get z0 from height !Config If = OK_SECHIBA !Config Def = 1/16. !Config Help = !Config Units = CALL getin_p('Z0_OVER_HEIGHT',z0_over_height) ! !Config Key = HEIGHT_DISPLACEMENT !Config Desc = Magic number which relates the height to the displacement height. !Config If = OK_SECHIBA !Config Def = 0.75 !Config Help = !Config Units = CALL getin_p('HEIGHT_DISPLACEMENT',height_displacement) ! !Config Key = Z0_BARE !Config Desc = bare soil roughness length !Config If = OK_SECHIBA !Config Def = 0.01 !Config Help = !Config Units = Meters (m) CALL getin_p('Z0_BARE',z0_bare) ! !Config Key = Z0_ICE !Config Desc = ice roughness length !Config If = OK_SECHIBA !Config Def = 0.001 !Config Help = !Config Units = Meters (m) CALL getin_p('Z0_ICE',z0_ice) ! !Config Key = TCST_SNOWA !Config Desc = Time constant of the albedo decay of snow !Config If = OK_SECHIBA !Config Def = 5.0 !Config Help = !Config Units = days [d] ? CALL getin_p('TCST_SNOWA',tcst_snowa) ! !Config Key = SNOWCRI_ALB !Config Desc = Critical value for computation of snow albedo !Config If = OK_SECHIBA !Config Def = 10. !Config Help = !Config Units = [Kg/m^2] CALL getin_p('SNOWCRI_ALB',snowcri_alb) ! ! !Config Key = VIS_DRY !Config Desc = The correspondance table for the soil color numbers and their albedo !Config If = OK_SECHIBA !Config Def = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27 !Config Help = !Config Units = CALL getin_p('VIS_DRY',vis_dry) ! !Config Key = NIR_DRY !Config Desc = The correspondance table for the soil color numbers and their albedo !Config If = OK_SECHIBA !Config Def = 0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55 !Config Help = !Config Units = CALL getin_p('NIR_DRY',nir_dry) ! !Config Key = VIS_WET !Config Desc = The correspondance table for the soil color numbers and their albedo !Config If = 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15 !Config Def = !Config Help = !Config Units = CALL getin_p('VIS_WET',vis_wet) ! !Config Key = NIR_WET !Config Desc = The correspondance table for the soil color numbers and their albedo !Config If = OK_SECHIBA !Config Def = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31 !Config Help = !Config Units = CALL getin_p('NIR_WET',nir_wet) ! !Config Key = ALBSOIL_VIS !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25 !Config Help = !Config Units = NONE CALL getin_p('ALBSOIL_VIS',albsoil_vis) ! !Config Key = ALBSOIL_NIR !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45 !Config Help = !Config Units = NONE CALL getin_p('ALBSOIL_NIR',albsoil_nir) !- ! !Config Key = ALB_DEADLEAF !Config Desc = albedo of dead leaves, VIS+NIR !Config If = OK_SECHIBA !Config Def = 0.12, 0.35 !Config Help = !Config Units = CALL getin_p('ALB_DEADLEAF',alb_deadleaf) ! !Config Key = ALB_ICE !Config Desc = albedo of ice, VIS+NIR !Config If = OK_SECHIBA !Config Def = 0.60, 0.20 !Config Help = !Config Units = NONE CALL getin_p('ALB_ICE',alb_ice) ! ! Get the fixed snow albedo if needed ! !Config Key = CONDVEG_SNOWA !Config Desc = The snow albedo used by SECHIBA !Config Def = DEF !Config Help = This option allows the user to impose a snow albedo. !Config Default behaviour is to use the model of snow albedo !Config developed by Chalita (1993). CALL getin_p('CONDVEG_SNOWA', fixed_snow_albedo) ! !Config Key = ALB_BARE_MODEL !Config Desc = Switch bare soil albedo dependent (if TRUE) on soil wetness !Config Def = FALSE !Config Help = If TRUE, the model for bare soil albedo is the old formulation. !Config Then it depend on the soil dry or wetness. If FALSE, it is the !Config new computation that is taken, it is the mean of soil albedo. CALL getin_p('ALB_BARE_MODEL', alb_bare_model) ! !Config Key = Z0CDRAG_AVE !Config Desc = Average method for z0 !Config Def = y !Config Help = If this flag is set to true (y) then the neutral Cdrag !Config is averaged instead of the log(z0). This should be !Config the prefered option. We still wish to keep the other !Config option so we can come back if needed. If this is !Config desired then one should set Z0CDRAG_AVE=n CALL getin_p('Z0CDRAG_AVE', z0cdrag_ave) ! !Config Key = IMPOSE_AZE !Config Desc = Should the surface parameters be prescribed !Config Def = n !Config Help = This flag allows the user to impose the surface parameters !Config (Albedo Roughness and Emissivity). It is espacially interesting for 0D !Config simulations. On the globe it does not make too much sense as !Config it imposes the same vegetation everywhere CALL getin_p('IMPOSE_AZE', impaze) ! IF(impaze) THEN ! !Config Key = CONDVEG_Z0 !Config Desc = Surface roughness (m) !Config Def = 0.15 !Config If = IMPOSE_AZE !Config Help = Surface rougness to be used on the point if a 0-dim version !Config of SECHIBA is used. Look at the description of the forcing !Config data for the correct value. CALL getin_p('CONDVEG_Z0', z0_scal) ! !Config Key = ROUGHHEIGHT !Config Desc = Height to be added to the height of the first level (m) !Config Def = 0.0 !Config If = IMPOSE_AZE !Config Help = ORCHIDEE assumes that the atmospheric level height is counted !Config from the zero wind level. Thus to take into account the roughness !Config of tall vegetation we need to correct this by a certain fraction !Config of the vegetation height. This is called the roughness height in !Config ORCHIDEE talk. CALL getin_p('ROUGHHEIGHT', roughheight_scal) ! !Config Key = CONDVEG_ALBVIS !Config Desc = SW visible albedo for the surface !Config Def = 0.25 !Config If = IMPOSE_AZE !Config Help = Surface albedo in visible wavelengths to be used !Config on the point if a 0-dim version of SECHIBA is used. !Config Look at the description of the forcing data for !Config the correct value. CALL getin_p('CONDVEG_ALBVIS', albedo_scal(ivis)) ! !Config Key = CONDVEG_ALBNIR !Config Desc = SW near infrared albedo for the surface !Config Def = 0.25 !Config If = IMPOSE_AZE !Config Help = Surface albedo in near infrared wavelengths to be used !Config on the point if a 0-dim version of SECHIBA is used. !Config Look at the description of the forcing data for !Config the correct value. CALL getin_p('CONDVEG_ALBNIR', albedo_scal(inir)) ! !Config Key = CONDVEG_EMIS !Config Desc = Emissivity of the surface for LW radiation !Config Def = 1.0 !Config If = IMPOSE_AZE !Config Help = The surface emissivity used for compution the LE emission !Config of the surface in a 0-dim version. Values range between !Config 0.97 and 1.. The GCM uses 0.98. CALL getin_p('CONDVEG_EMIS', emis_scal) ENDIF ! !- ! diffuco !- ! !Config Key = NLAI !Config Desc = !Config If = OK_SECHIBA !Config Def = 20 !Config Help = dimension of an array used in diffuco !Config Units = NONE CALL getin_p('NLAI',nlai) ! !Config Key = LAIMAX !Config Desc = !Config If = OK_SECHIBA !Config Def = !Config Help = !Config Units = CALL getin_p('LAIMAX',laimax) ! !Config Key = XC4_1 !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.83 !Config Help = !Config Units = CALL getin_p('XC4_1',xc4_1) ! !Config Key = XC4_2 !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.93 !Config Help = !Config Units = CALL getin_p('XC4_2',xc4_2) ! !Config Key = DEW_VEG_POLY_COEFF !Config Desc = coefficients of the polynome of degree 5 for the dew !Config If = OK_SECHIBA !Config Def = 0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017 !Config Help = !Config Units = CALL getin_p('DEW_VEG_POLY_COEFF',dew_veg_poly_coeff) !- ! slowproc !- ! !Config Key = CLAYFRACTION_DEFAULT !Config Desc = !Config If = OK_SECHIBA !Config Def = 0.2 !Config Help = !Config Units = NONE CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default) ! !Config Key = MIN_VEGFRAC !Config Desc = Minimal fraction of mesh a vegetation type can occupy !Config If = OK_SECHIBA !Config Def = 0.001 !Config Help = !Config Units = NONE CALL getin_p('MIN_VEGFRAC',min_vegfrac) ! !Config Key = STEMPDIAG_BID !Config Desc = only needed for an initial LAI if there is no restart file !Config If = OK_SECHIBA !Config Def = 280. !Config Help = !Config Units = CALL getin_p('STEMPDIAG_BID',stempdiag_bid) ! !Config Key = SOILTYPE_DEFAULT !Config Desc = Default soil texture distribution in the following order : sand, loam and clay !Config If = OK_SECHIBA !Config Def = 0.0, 1.0, 0.0 !Config Help = !Config Units = NONE CALL getin_p('SOILTYPE_DEFAULT',soiltype_default) ! first_call =.FALSE. ENDIF END SUBROUTINE getin_sechiba_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 ! !Config Key = LAI_LEVEL_DEPTH !Config Desc = !Config If = OK_CO2 !Config Def = 0.15 !Config Help = !Config Units = CALL getin_p('LAI_LEVEL_DEPTH',lai_level_depth) ! !Config Key = X1_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 0.177 !Config Help = !Config Units = CALL getin_p('X1_COEF',x1_coef) ! !Config Key = X1_Q10 !Config Desc = !Config If = OK_CO2 !Config Def = 0.069 !Config Help = !Config Units = CALL getin_p('X1_Q10',x1_Q10) ! !Config Key = QUANTUM_YIELD !Config Desc = !Config If = OK_CO2 !Config Def = 0.092 !Config Help = !Config Units = CALL getin_p('QUANTUM_YIELD',quantum_yield) ! !Config Key = KT_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 0.7 !Config Help = !Config Units = CALL getin_p('KT_COEF',kt_coef) ! !Config Key = KC_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 39.09 !Config Help = !Config Units = CALL getin_p('KC_COEF',kc_coef) ! !Config Key = KO_Q10 !Config Desc = !Config If = OK_CO2 !Config Def = 0.085 !Config Help = !Config Units = CALL getin_p('KO_Q10',Ko_Q10) ! !Config Key = OA !Config Desc = !Config If = OK_CO2 !Config Def = 210000. !Config Help = !Config Units = CALL getin_p('OA',Oa) ! !Config Key = KO_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 2.412 !Config Help = !Config Units = CALL getin_p('KO_COEF',Ko_coef) ! !Config Key = CP_0 !Config Desc = !Config If = OK_CO2 !Config Def = 42. !Config Help = !Config Units = CALL getin_p('CP_0',CP_0) ! !Config Key = CP_TEMP_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 9.46 !Config Help = !Config Units = CALL getin_p('CP_TEMP_COEF',cp_temp_coef) ! !Config Key = CP_TEMP_REF !Config Desc = !Config If = OK_CO2 !Config Def = 25. !Config Help = !Config Units = degrees Celsius ? CALL getin_p('CP_TEMP_REF',cp_temp_ref) ! !Config Key = RT_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 0.8, 1.3 !Config Help = !Config Units = CALL getin_p('RT_COEF',rt_coef) ! !Config Key = VC_COEF !Config Desc = !Config If = OK_CO2 !Config Def = 0.39, 0.3 !Config Help = !Config Units = CALL getin_p('VC_COEF',vc_coef) first_call =.FALSE. ENDIF END SUBROUTINE getin_co2_parameters ! != ! SUBROUTINE getin_hydrolc_parameters LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN ! !Config Key = QWILT !Config Desc = Wilting point !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 5.0 !Config Help = !Config Units = CALL getin_p('QWILT',qwilt) ! !Config Key = MIN_RESDIS !Config Desc = The minimal size we allow for the upper reservoir !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 2.e-5 !Config Help = !Config Units = Meters (m) CALL getin_p('MIN_RESDIS',min_resdis) ! !Config Key = MIN_DRAIN !Config Desc = Diffusion constant for the slow regime !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 0.001 !Config Help = !Config Units = CALL getin_p('MIN_DRAIN',min_drain) ! !Config Key = MAX_DRAIN !Config Desc = Diffusion constant for the fast regime !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 0.1 !Config Help = !Config Units = CALL getin_p('MAX_DRAIN',max_drain) ! !Config Key = EXP_DRAIN !Config Desc = The exponential in the diffusion law !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 1.5 !Config Help = !Config Units = CALL getin_p('EXP_DRAIN',exp_drain) ! !Config Key = RSOL_CSTE !Config Desc = Constant in the computation of resistance for bare soil evaporation !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 33.E3 !Config Help = !Config Units = CALL getin_p('RSOL_CSTE',rsol_cste) ! !Config Key = HCRIT_LITTER !Config Desc = Scaling depth for litter humidity (m) !Config If = OK_SECHIBA and .NOT.(OK_CWRR) !Config Def = 0.08 !Config Help = !Config Units = CALL getin_p('HCRIT_LITTER',hcrit_litter) ! !Config Key = HYDROL_OK_HDIFF !Config Desc = do horizontal diffusion? !Config Def = n !Config Help = If TRUE, then water can diffuse horizontally between !Config the PFTs' water reservoirs. CALL getin_p('HYDROL_OK_HDIFF',ok_hdiff) first_call =.FALSE. ENDIF END SUBROUTINE getin_hydrolc_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 ! !Config Key = W_TIME !Config Desc = Time weighting for discretisation !Config If = OK_CWRR !Config Def = 1. !Config Help = !Config Units = CALL getin_p('W_TIME',w_time) ! !Config Key = NVAN !Config Desc = Van genuchten coefficient n !Config If = OK_CWRR !Config Def = 1.89, 1.56, 1.31 !Config Help = !Config Units = CALL getin_p('NVAN',nvan) ! !Config Key = AVAN !Config Desc = Van genuchten coefficient a (mm^{-1}) !Config If = OK_CWRR !Config Def = 0.0075, 0.0036, 0.0019 !Config Help = !Config Units = [1/mm] CALL getin_p('AVAN',avan) ! !Config Key = MCR !Config Desc = Residual soil water content !Config If = OK_CWRR !Config Def = 0.065, 0.078, 0.095 !Config Help = !Config Units = CALL getin_p('MCR',mcr) ! !Config Key = MCS !Config Desc = Saturated soil water content !Config If = OK_CWRR !Config Def = 0.41, 0.43, 0.41 !Config Help = !Config Units = CALL getin_p('MCS',mcs) ! !Config Key = KS !Config Desc = Hydraulic conductivity Saturation !Config If = OK_CWRR !Config Def = 1060.8, 249.6, 62.4 !Config Help = !Config Units = [mm/d] CALL getin_p('KS',ks) ! !Config Key = PCENT !Config Desc = Soil moisture above which transpir is max !Config If = OK_CWRR !Config Def = 0.5, 0.5, 0.5 !Config Help = !Config Units = CALL getin_p('PCENT',pcent) ! !Config Key = FREE_DRAIN_MAX !Config Desc = Max value of the permeability coeff at the bottom of the soil !Config If = OK_CWRR !Config Def = 1.0, 1.0, 1.0 !Config Help = !Config Units = CALL getin_p('FREE_DRAIN_MAX',free_drain_max) ! !Config Key = MCF !Config Desc = Volumetric water content field capacity !Config If = OK_CWRR !Config Def = 0.32, 0.32, 0.32 !Config Help = !Config Units = CALL getin_p('MCF',mcf) ! !Config Key = MCW !Config Desc = Volumetric water content Wilting pt !Config If = OK_CWRR !Config Def = 0.10, 0.10, 0.10 !Config Help = !Config Units = CALL getin_p('MCW',mcw) ! !Config Key = MC_AWET !Config Desc = Vol. wat. cont. above which albedo is cst !Config If = OK_CWRR !Config Def = 0.25, 0.25, 0.25 !Config Help = !Config Units = CALL getin_p('MC_AWET',mc_awet) ! !Config Key = MC_ADRY !Config Desc = Vol. wat. cont. below which albedo is cst !Config If = OK_CWRR !Config Def = 0.1, 0.1, 0.1 !Config Help = !Config Units = CALL getin_p('MC_ADRY',mc_adry) first_call =.FALSE. ENDIF END SUBROUTINE getin_hydrol_cwrr_parameters ! != ! SUBROUTINE getin_routing_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN ! !Config Key = CROP_COEF !Config Desc = Parameter for the Kassel irrigation parametrization linked to the crops !Config If = OK_ROUTING !Config Def = 1.5 !Config Help = !Config Units = CALL getin_p('CROP_COEF',crop_coef) first_call =.FALSE. ENDIF END SUBROUTINE getin_routing_parameters ! != ! SUBROUTINE getin_stomate_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN !- ! constraints_parameters !- ! !Config Key = TOO_LONG !Config Desc = longest sustainable time without regeneration (vernalization) !Config If = OK_STOMATE !Config Def = 5. !Config Help = !Config Units = days (d) CALL getin_p('TOO_LONG',too_long) !- ! fire parameters !- ! !Config Key = TAU_FIRE !Config Desc = Time scale for memory of the fire index (days). Validated for one year in the DGVM. !Config If = OK_STOMATE !Config Def = !Config Help = !Config Units = days [d] CALL getin_p('TAU_FIRE',tau_fire) ! !Config Key = LITTER_CRIT !Config Desc = Critical litter quantity for fire !Config If = OK_STOMATE !Config Def = 200. !Config Help = !Config Units = CALL getin_p('LITTER_CRIT',litter_crit) ! !Config Key = CO2FRAC !Config Desc = What fraction of a burned plant compartment goes into the atmosphere !Config If = OK_STOMATE !Config Def = .95, .95, 0., 0.3, 0., 0., .95, .95 !Config Help = !Config Units = NONE CALL getin_p('CO2FRAC',co2frac) ! !Config Key = BCFRAC_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 0.3, 1.3, 88.2 !Config Help = !Config Units = CALL getin_p('BCFRAC_COEFF',bcfrac_coeff) ! !Config Key = FIREFRAC_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 0.45, 0.8, 0.6, 0.13 !Config Help = !Config Units = CALL getin_p('FIREFRAC_COEFF',firefrac_coeff) !- ! gap parameters (+ lpj_const_mort) !- ! !Config Key = AVAILABILITY_FACT !Config Desc = !Config If = OK_STOMATE !Config Def = 0.02 !Config Help = !Config Units = CALL getin_p('AVAILABILITY_FACT', availability_fact) ! !Config Key = VIGOUR_REF !Config Desc = !Config If = OK_STOMATE !Config Def = 0.17 !Config Help = !Config Units = CALL getin_p('VIGOUR_REF',vigour_ref) ! !Config Key = VIGOUR_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 70. !Config Help = !Config Units = CALL getin_p('VIGOUR_COEFF',vigour_coeff) !- ! allocation parameters !- ! !Config Key = OK_MINRES !Config Desc = Do we try to reach a minimum reservoir even if we are severely stressed? !Config If = OK_STOMATE !Config Def = y !Config Help = !Config Units = NONE CALL getin_p('OK_MINRES',ok_minres) ! !Config Key = TAU_LEAFINIT !Config Desc = time to attain the initial foliage using the carbohydrate reserve !Config If = OK_STOMATE !Config Def = 10. !Config Help = !Config Units = dayd [d] CALL getin_p('TAU_LEAFINIT', tau_leafinit) ! !Config Key = RESERVE_TIME_TREE !Config Desc = maximum time during which reserve is used (trees) !Config If = OK_STOMATE !Config Def = 30. !Config Help = !Config Units = dayd [d] CALL getin_p('RESERVE_TIME_TREE',reserve_time_tree) ! !Config Key = RESERVE_TIME_GRASS !Config Desc = maximum time during which reserve is used (grasses) !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = dayd [d] CALL getin_p('RESERVE_TIME_GRASS',reserve_time_grass) ! !Config Key = R0 !Config Desc = Standard root allocation !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('R0',R0) ! !Config Key = S0 !Config Desc = Standard sapwood allocation !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('S0',S0) ! !Config Key = F_FRUIT !Config Desc = Standard fruit allocation !Config If = OK_STOMATE !Config Def = 0.1 !Config Help = !Config Units = CALL getin_p('F_FRUIT',f_fruit) ! !Config Key = ALLOC_SAP_ABOVE_TREE !Config Desc = fraction of sapwood allocation above ground !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = NONE CALL getin_p('ALLOC_SAP_ABOVE_TREE',alloc_sap_above_tree) ! !Config Key = ALLOC_SAP_ABOVE_GRASS !Config Desc = fraction of sapwood allocation above ground !Config If = OK_STOMATE !Config Def = 1.0 !Config Help = !Config Units = NONE CALL getin_p('ALLOC_SAP_ABOVE_GRASS',alloc_sap_above_grass) ! !Config Key = MIN_LTOLSR !Config Desc = extrema of leaf allocation fraction !Config If = OK_STOMATE !Config Def = 0.2 !Config Help = !Config Units = NONE CALL getin_p('MIN_LTOLSR',min_LtoLSR) ! !Config Key = MAX_LTOLSR !Config Desc = extrema of leaf allocation fraction !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = NONE CALL getin_p('MAX_LTOLSR',max_LtoLSR) ! !Config Key = Z_NITROGEN !Config Desc = scaling depth for nitrogen limitation !Config If = OK_STOMATE !Config Def = 0.2 !Config Help = !Config Units = meters (m) CALL getin_p('Z_NITROGEN',z_nitrogen) ! !Config Key = LAI_MAX_TO_HAPPY !Config Desc = !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('LAI_MAX_TO_HAPPY',lai_max_to_happy) ! !Config Key = NLIM_TREF !Config Desc = !Config If = OK_STOMATE !Config Def = 25. !Config Help = !Config Units = Degrees Celsius [C] CALL getin_p('NLIM_TREF',Nlim_tref) !- ! data parameters !- ! !Config Key = PIPE_TUNE1 !Config Desc = crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory) !Config If = OK_STOMATE !Config Def = 100.0 !Config Help = !Config Units = CALL getin_p('PIPE_TUNE1',pipe_tune1) ! !Config Key = PIPE_TUNE2 !Config Desc = height=pipe_tune2 * diameter**pipe_tune3 !Config If = OK_STOMATE !Config Def = 40.0 !Config Help = !Config Units = CALL getin_p('PIPE_TUNE2',pipe_tune2) ! !Config Key = PIPE_TUNE3 !Config Desc = height=pipe_tune2 * diameter**pipe_tune3 !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('PIPE_TUNE3',pipe_tune3) ! !Config Key = PIPE_TUNE4 !Config Desc = needed for stem diameter !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('PIPE_TUNE4',pipe_tune4) ! !Config Key = PIPE_DENSITY !Config Desc = Density !Config If = OK_STOMATE !Config Def = 2.e5 !Config Help = !Config Units = CALL getin_p('PIPE_DENSITY',pipe_density) ! !Config Key = PIPE_K1 !Config Desc = !Config If = OK_STOMATE !Config Def = 8.e3 !Config Help = !Config Units = CALL getin_p('PIPE_K1',pipe_k1) ! !Config Key = PIPE_TUNE_EXP_COEFF !Config Desc = pipe tune exponential coeff !Config If = OK_STOMATE !Config Def = 1.6 !Config Help = !Config Units = NONE CALL getin_p('PIPE_TUNE_EXP_COEFF',pipe_tune_exp_coeff) ! ! !Config Key = PRECIP_CRIT !Config Desc = minimum precip !Config If = OK_STOMATE !Config Def = 100. !Config Help = !Config Units = [mm/year] CALL getin_p('PRECIP_CRIT',precip_crit) ! !Config Key = GDD_CRIT_ESTAB !Config Desc = minimum gdd for establishment of saplings !Config If = OK_STOMATE !Config Def = 150. !Config Help = !Config Units = CALL getin_p('GDD_CRIT_ESTAB',gdd_crit_estab) ! !Config Key = FPC_CRIT !Config Desc = critical fpc, needed for light competition and establishment !Config If = OK_STOMATE !Config Def = 0.95 !Config Help = !Config Units = CALL getin_p('FPC_CRIT',fpc_crit) ! !Config Key = ALPHA_GRASS !Config Desc = sapling characteristics : alpha's !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('ALPHA_GRASS',alpha_grass) ! !Config Key = ALPHA_TREE !Config Desc = sapling characteristics : alpha's !Config If = OK_STOMATE !Config Def = 1. !Config Help = !Config Units = CALL getin_p('ALPHA_TREE',alpha_tree) !- ! !Config Key = MASS_RATIO_HEART_SAP !Config Desc = mass ratio (heartwood+sapwood)/sapwood !Config If = OK_STOMATE !Config Def = 3. !Config Help = !Config Units = NONE CALL getin_p('MASS_RATIO_HEART_SAP',mass_ratio_heart_sap) ! !Config Key = FRAC_GROWTHRESP !Config Desc = fraction of GPP which is lost as growth respiration !Config If = OK_STOMATE !Config Def = 0.28 !Config Help = !Config Units = NONE CALL getin_p('FRAC_GROWTHRESP',frac_growthresp) ! !Config Key = TAU_HUM_MONTH !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = days [d] CALL getin_p('TAU_HUM_MONTH',tau_hum_month) ! !Config Key = TAU_HUM_WEEK !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 7. !Config Help = !Config Units = days [d] CALL getin_p('TAU_HUM_WEEK',tau_hum_week) ! !Config Key = TAU_T2M_MONTH !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = CALL getin_p('TAU_T2M_MONTH',tau_t2m_month) ! !Config Key = TAU_T2M_WEEK !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 7. !Config Help = !Config Units = days [d] CALL getin_p('TAU_T2M_WEEK',tau_t2m_week) ! !Config Key = TAU_TSOIL_MONTH !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = CALL getin_p('TAU_TSOIL_MONTH',tau_tsoil_month) ! !Config Key = TAU_SOILHUM_MONTH !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = days [d] CALL getin_p('TAU_SOILHUM_MONTH',tau_soilhum_month) ! !Config Key = TAU_GPP_WEEK !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 7. !Config Help = !Config Units = days [d] CALL getin_p('TAU_GPP_WEEK',tau_gpp_week) ! !Config Key = TAU_GDD !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 40. !Config Help = !Config Units = days [d] CALL getin_p('TAU_GDD',tau_gdd) ! !Config Key = TAU_NGD !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 50. !Config Help = !Config Units = days [d] CALL getin_p('TAU_NGD',tau_ngd) ! !Config Key = COEFF_TAU_LONGTERM !Config Desc = time scales for phenology and other processes !Config If = OK_STOMATE !Config Def = 3. !Config Help = !Config Units = days [d] CALL getin_p('COEFF_TAU_LONGTERM',coeff_tau_longterm) !- ! !Config Key = BM_SAPL_CARBRES !Config Desc = !Config If = OK_STOMATE !Config Def = 5. !Config Help = !Config Units = CALL getin_p('BM_SAPL_CARBRES',bm_sapl_carbres) ! !Config Key = BM_SAPL_SAPABOVE !Config Desc = !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('BM_SAPL_SAPABOVE',bm_sapl_sapabove) ! !Config Key = BM_SAPL_HEARTABOVE !Config Desc = !Config If = OK_STOMATE !Config Def = 2. !Config Help = !Config Units = CALL getin_p('BM_SAPL_HEARTABOVE',bm_sapl_heartabove) ! !Config Key = BM_SAPL_HEARTBELOW !Config Desc = !Config If = OK_STOMATE !Config Def = 2. !Config Help = !Config Units = CALL getin_p('BM_SAPL_HEARTBELOW',bm_sapl_heartbelow) ! !Config Key = INIT_SAPL_MASS_LEAF_NAT !Config Desc = !Config If = OK_STOMATE !Config Def = 0.1 !Config Help = !Config Units = CALL getin_p('INIT_SAPL_MASS_LEAF_NAT',init_sapl_mass_leaf_nat) ! !Config Key = INIT_SAPL_MASS_LEAF_AGRI !Config Desc = !Config If = OK_STOMATE !Config Def = 1. !Config Help = !Config Units = CALL getin_p('INIT_SAPL_MASS_LEAF_AGRI',init_sapl_mass_leaf_agri) ! !Config Key = INIT_SAPL_MASS_CARBRES !Config Desc = !Config If = OK_STOMATE !Config Def = 5. !Config Help = !Config Units = CALL getin_p('INIT_SAPL_MASS_CARBRES',init_sapl_mass_carbres) ! !Config Key = INIT_SAPL_MASS_ROOT !Config Desc = !Config If = OK_STOMATE !Config Def = 0.1 !Config Help = !Config Units = CALL getin_p('INIT_SAPL_MASS_ROOT',init_sapl_mass_root) ! !Config Key = INIT_SAPL_MASS_FRUIT !Config Desc = !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('INIT_SAPL_MASS_FRUIT',init_sapl_mass_fruit) ! !Config Key = CN_SAPL_INIT !Config Desc = !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('CN_SAPL_INIT',cn_sapl_init) ! !Config Key = MIGRATE_TREE !Config Desc = !Config If = OK_STOMATE !Config Def = 10.*1.E3 !Config Help = !Config Units = CALL getin_p('MIGRATE_TREE',migrate_tree) ! !Config Key = MIGRATE_GRASS !Config Desc = !Config If = OK_STOMATE !Config Def = 10.*1.E3 !Config Help = !Config Units = CALL getin_p('MIGRATE_GRASS',migrate_grass) ! !Config Key = LAI_INITMIN_TREE !Config Desc = !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('LAI_INITMIN_TREE',lai_initmin_tree) ! !Config Key = LAI_INITMIN_GRASS !Config Desc = !Config If = OK_STOMATE !Config Def = 0.1 !Config Help = !Config Units = CALL getin_p('LAI_INITMIN_GRASS',lai_initmin_grass) ! !Config Key = DIA_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 4., 0.5 !Config Help = !Config Units = CALL getin_p('DIA_COEFF',dia_coeff) ! !Config Key = MAXDIA_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 100., 0.01 !Config Help = !Config Units = CALL getin_p('MAXDIA_COEFF',maxdia_coeff) ! !Config Key = BM_SAPL_LEAF !Config Desc = !Config If = OK_STOMATE !Config Def = 4., 4., .8, 5. !Config Help = !Config Units = CALL getin_p('BM_SAPL_LEAF',bm_sapl_leaf) !- ! litter parameters !- ! !Config Key = METABOLIC_REF_FRAC !Config Desc = !Config If = OK_STOMATE !Config Def = 0.85 !Config Help = !Config Units = NONE CALL getin_p('METABOLIC_REF_FRAC',metabolic_ref_frac) ! !Config Key = Z_DECOMP !Config Desc = scaling depth for soil activity !Config If = OK_STOMATE !Config Def = 0.2 !Config Help = !Config Units = meters [m] CALL getin_p('Z_DECOMP',z_decomp) ! !Config Key = CN !Config Desc = C/N ratio !Config If = OK_STOMATE !Config Def = 40.,40.,40.,40.,40.,40.,40.,40. !Config Help = !Config Units = NONE CALL getin_p('CN',CN) ! !Config Key = LC !Config Desc = Lignine/C ratio of the different plant parts !Config If = OK_STOMATE !Config Def = 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 !Config Help = !Config Units = NONE CALL getin_p('LC',LC) ! !Config Key = FRAC_SOIL_STRUCT_AA !Config Desc = frac_soil(istructural,iactive,iabove) !Config If = OK_STOMATE !Config Def = 0.55 !Config Help = !Config Units = NONE CALL getin_p('FRAC_SOIL_STRUCT_AA',frac_soil_struct_aa) ! !Config Key = FRAC_SOIL_STRUCT_A !Config Desc = frac_soil(istructural,iactive,ibelow) !Config If = OK_STOMATE !Config Def = 0.45 !Config Help = !Config Units = NONE CALL getin_p('FRAC_SOIL_STRUCT_AB',frac_soil_struct_ab) ! !Config Key = FRAC_SOIL_STRUCT_SA !Config Desc = frac_soil(istructural,islow,iabove) !Config If = OK_STOMATE !Config Def = 0.7 !Config Help = !Config Units = NONE CALL getin_p('FRAC_SOIL_STRUCT_SA',frac_soil_struct_sa) ! !Config Key = FRAC_SOIL_STRUCT_SB !Config Desc = frac_soil(istructural,islow,ibelow) !Config If = OK_STOMATE !Config Def = 0.7 !Config Help = !Config Units = NONE CALL getin_p('FRAC_SOIL_STRUCT_SB',frac_soil_struct_sb) ! !Config Key = FRAC_SOIL_METAB_AA !Config Desc = frac_soil(imetabolic,iactive,iabove) !Config If = OK_STOMATE !Config Def = 0.45 !Config Help = !Config Units = NONE CALL getin_p('FRAC_SOIL_METAB_AA',frac_soil_metab_aa) ! !Config Key = FRAC_SOIL_METAB_AB !Config Desc = frac_soil(imetabolic,iactive,ibelow) !Config If = OK_STOMATE !Config Def = 0.45 !Config Help = !Config Units = NONE CALL getin_p('FRAC_SOIL_METAB_AB',frac_soil_metab_ab) ! ! !Config Key = METABOLIC_LN_RATIO !Config Desc = !Config If = OK_STOMATE !Config Def = 0.018 !Config Help = !Config Units = CALL getin_p('METABOLIC_LN_RATIO',metabolic_LN_ratio) ! !Config Key = TAU_METABOLIC !Config Desc = !Config If = OK_STOMATE !Config Def = 0.066 !Config Help = !Config Units = days [d] ? CALL getin_p('TAU_METABOLIC',tau_metabolic) ! !Config Key = TAU_STRUCT !Config Desc = !Config If = OK_STOMATE !Config Def = 0.245 !Config Help = !Config Units = days [d] ? CALL getin_p('TAU_STRUCT',tau_struct) ! !Config Key = SOIL_Q10 !Config Desc = !Config If = OK_STOMATE !Config Def = .69 (=ln2) !Config Help = !Config Units = CALL getin_p('SOIL_Q10',soil_Q10) ! !Config Key = TSOIL_REF !Config Desc = !Config If = OK_STOMATE !Config Def = 30. !Config Help = !Config Units = Celsius degrees [C] CALL getin_p('TSOIL_REF',tsoil_ref) ! !Config Key = LITTER_STRUCT_COEF !Config Desc = !Config If = OK_STOMATE !Config Def = 3. !Config Help = !Config Units = CALL getin_p('LITTER_STRUCT_COEF',litter_struct_coef) ! !Config Key = MOIST_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 1.1, 2.4, 0.29 !Config Help = !Config Units = CALL getin_p('MOIST_COEFF',moist_coeff) !- ! lpj parameters !- ! !Config Key = FRAC_TURNOVER_DAILY !Config Desc = !Config If = OK_STOMATE !Config Def = 0.55 !Config Help = !Config Units = NONE CALL getin_p('FRAC_TURNOVER_DAILY',frac_turnover_daily) !- ! npp parameters !- ! !Config Key = TAX_MAX !Config Desc = maximum fraction of allocatable biomass used for maintenance respiration !Config If = OK_STOMATE !Config Def = 0.8 !Config Help = !Config Units = NONE CALL getin_p('TAX_MAX',tax_max) !- ! phenology parameters !- ! !Config Key = ALWAYS_INIT !Config Desc = take carbon from atmosphere if carbohydrate reserve too small? !Config If = OK_STOMATE !Config Def = n !Config Help = !Config Units = NONE CALL getin_p('ALWAYS_INIT',always_init) ! !Config Key = MIN_GROWTHINIT_TIME !Config Desc = minimum time since last beginning of a growing season !Config If = OK_STOMATE !Config Def = 300. !Config Help = !Config Units = days [d] CALL getin_p('MIN_GROWTHINIT_TIME',min_growthinit_time) ! !Config Key = MOIAVAIL_ALWAYS_TREE !Config Desc = moisture availability above which moisture tendency doesn't matter !Config If = OK_STOMATE !Config Def = 1.0 !Config Help = !Config Units = CALL getin_p('MOIAVAIL_ALWAYS_TREE',moiavail_always_tree) ! !Config Key = MOIAVAIL_ALWAYS_GRASS !Config Desc = moisture availability above which moisture tendency doesn't matter !Config If = OK_STOMATE !Config Def = 0.6 !Config Help = !Config Units = CALL getin_p('MOIAVAIL_ALWAYS_GRASS',moiavail_always_grass) ! !Config Key = T_ALWAYS_ADD !Config Desc = monthly temp. above which temp. tendency doesn't matter !Config If = OK_STOMATE !Config Def = 10. !Config Help = !Config Units = Celsius degrees [C] CALL getin_p('T_ALWAYS_ADD',t_always_add) ! ! !Config Key = GDDNCD_REF !Config Desc = !Config If = OK_STOMATE !Config Def = 603. !Config Help = !Config Units = CALL getin_p('GDDNCD_REF',gddncd_ref) ! !Config Key = GDDNCD_CURVE !Config Desc = !Config If = OK_STOMATE !Config Def = 0.0091 !Config Help = !Config Units = CALL getin_p('GDDNCD_CURVE',gddncd_curve) ! !Config Key = GDDNCD_OFFSET !Config Desc = !Config If = OK_STOMATE !Config Def = 64. !Config Help = !Config Units = CALL getin_p('GDDNCD_OFFSET',gddncd_offset) !- ! prescribe parameters !- ! !Config Key = CN_TREE !Config Desc = !Config If = OK_STOMATE !Config Def = 4. !Config Help = !Config Units = CALL getin_p('CN_TREE',cn_tree) ! !Config Key = BM_SAPL_RESCALE !Config Desc = !Config If = OK_STOMATE !Config Def = 40. !Config Help = !Config Units = CALL getin_p('BM_SAPL_RESCALE',bm_sapl_rescale) !- ! respiration parameters !- ! !Config Key = MAINT_RESP_MIN_VMAX !Config Desc = !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('MAINT_RESP_MIN_VMAX',maint_resp_min_vmax) ! !Config Key = MAINT_RESP_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 1.4 !Config Help = !Config Units = CALL getin_p('MAINT_RESP_COEFF',maint_resp_coeff) !- ! soilcarbon parameters !- ! !Config Key = FRAC_CARB_AA !Config Desc = frac carb coefficients from active pool: depends on clay content !Config if = OK_STOMATE !Config Def = 0.0 !Config Help = fraction of the active pool going to the active pool !Config Units = NONE CALL getin_p('FRAC_CARB_AA',frac_carb_aa) ! !Config Key = FRAC_CARB_AP !Config Desc = frac carb coefficients from active pool: depends on clay content !Config if = OK_STOMATE !Config Def = 0.004 !Config Help = fraction of the active pool going to the passive pool !Config Units = NONE CALL getin_p('FRAC_CARB_AP',frac_carb_ap) ! !Config Key = FRAC_CARB_SS !Config Desc = frac_carb_coefficients from slow pool !Config if = OK_STOMATE !Config Def = 0.0 !Config Help = fraction of the slow pool going to the slow pool !Config Units = NONE CALL getin_p('FRAC_CARB_SS',frac_carb_ss) ! !Config Key = FRAC_CARB_SA !Config Desc = frac_carb_coefficients from slow pool !Config if = OK_STOMATE !Config Def = 0.42 !Config Help = fraction of the slow pool going to the active pool !Config Units = NONE CALL getin_p('FRAC_CARB_SA',frac_carb_sa) ! !Config Key = FRAC_CARB_SP !Config Desc = frac_carb_coefficients from slow pool !Config if = OK_STOMATE !Config Def = 0.03 !Config Help = fraction of the slow pool going to the passive pool !Config Units = NONE CALL getin_p('FRAC_CARB_SP',frac_carb_sp) ! !Config Key = FRAC_CARB_PP !Config Desc = frac_carb_coefficients from passive pool !Config if = OK_STOMATE !Config Def = 0.0 !Config Help = fraction of the passive pool going to the passive pool !Config Units = NONE CALL getin_p('FRAC_CARB_PP',frac_carb_pp) ! !Config Key = FRAC_CARB_PA !Config Desc = frac_carb_coefficients from passive pool !Config if = OK_STOMATE !Config Def = 0.45 !Config Help = fraction of the passive pool going to the passive pool !Config Units = NONE CALL getin_p('FRAC_CARB_PA',frac_carb_pa) ! !Config Key = FRAC_CARB_PS !Config Desc = frac_carb_coefficients from passive pool !Config if = OK_STOMATE !Config Def = 0.0 !Config Help = fraction of the passive pool going to the passive pool !Config Units = NONE CALL getin_p('FRAC_CARB_PS',frac_carb_ps) ! !Config Key = ACTIVE_TO_PASS_CLAY_FRAC !Config Desc = !Config if = OK_STOMATE !Config Def = .68 !Config Help = !Config Units = NONE CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac) ! !Config Key = CARBON_TAU_IACTIVE !Config Desc = residence times in carbon pools !Config if = OK_STOMATE !Config Def = 0.149 !Config Help = !Config Units = days [d] CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive) ! !Config Key = CARBON_TAU_ISLOW !Config Desc = residence times in carbon pools !Config if = OK_STOMATE !Config Def = 5.48 !Config Help = !Config Units = days [d] CALL getin_p('CARBON_TAU_ISLOW',carbon_tau_islow) ! !Config Key = CARBON_TAU_IPASSIVE !Config Desc = residence times in carbon pools !Config if = OK_STOMATE !Config Def = 241. !Config Help = !Config Units = days [d] CALL getin_p('CARBON_TAU_IPASSIVE',carbon_tau_ipassive) ! !Config Key = FLUX_TOT_COEFF !Config Desc = !Config if = OK_STOMATE !Config Def = 1.2, 1.4,.75 !Config Help = !Config Units = days [d] CALL getin_p('FLUX_TOT_COEFF',flux_tot_coeff) !- ! turnover parameters !- ! !Config Key = NEW_TURNOVER_TIME_REF !Config Desc = !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = CALL getin_p('NEW_TURNOVER_TIME_REF',new_turnover_time_ref) ! !Config Key = DT_TURNOVER_TIME !Config Desc = !Config If = OK_STOMATE !Config Def = 10. !Config Help = !Config Units = CALL getin_p('DT_TURNOVER_TIME',dt_turnover_time) ! !Config Key = LEAF_AGE_CRIT_TREF !Config Desc = !Config If = OK_STOMATE !Config Def = 20. !Config Help = !Config Units = CALL getin_p('LEAF_AGE_CRIT_TREF',leaf_age_crit_tref) ! !Config Key = LEAF_AGE_CRIT_COEFF !Config Desc = !Config If = OK_STOMATE !Config Def = 1.5, 0.75, 10. !Config Help = !Config Units = CALL getin_p('LEAF_AGE_CRIT_COEFF',leaf_age_crit_coeff) !- ! vmax parameters !- ! !Config Key = VMAX_OFFSET !Config Desc = offset (minimum relative vcmax) !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('VMAX_OFFSET',vmax_offset) ! !Config Key = LEAFAGE_FIRSTMAX !Config Desc = leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age) !Config If = OK_STOMATE !Config Def = 0.03 !Config Help = !Config Units = CALL getin_p('LEAFAGE_FIRSTMAX',leafage_firstmax) ! !Config Key = LEAFAGE_LASTMAX !Config Desc = leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age) !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('LEAFAGE_LASTMAX',leafage_lastmax) ! !Config Key = LEAFAGE_OLD !Config Desc = leaf age at which vmax attains its minimum (in fraction of critical leaf age) !Config If = OK_STOMATE !Config Def = 1. !Config Help = !Config Units = CALL getin_p('LEAFAGE_OLD',leafage_old) !- ! season parameters !- ! !Config Key = GPPFRAC_DORMANCE !Config Desc = rapport maximal GPP/GGP_max pour dormance !Config If = OK_STOMATE !Config Def = 0.2 !Config Help = !Config Units = NONE CALL getin_p('GPPFRAC_DORMANCE',gppfrac_dormance) ! !Config Key = MIN_GPP_ALLOWED !Config Desc = minimum gpp considered as not "lowgpp" !Config If = OK_STOMATE !Config Def = 0.3 !Config Help = !Config Units = CALL getin_p('MIN_GPP_ALLOWED',min_gpp_allowed) ! !Config Key = TAU_CLIMATOLOGY !Config Desc = tau for "climatologic variables !Config If = OK_STOMATE !Config Def = 20 !Config Help = !Config Units = year [y] ? CALL getin_p('TAU_CLIMATOLOGY',tau_climatology) ! !Config Key = HVC1 !Config Desc = parameters for herbivore activity !Config If = OK_STOMATE !Config Def = 0.019 !Config Help = !Config Units = CALL getin_p('HVC1',hvc1) ! !Config Key = HVC2 !Config Desc = parameters for herbivore activity !Config If = OK_STOMATE !Config Def = 1.38 !Config Help = !Config Units = CALL getin_p('HVC2',hvc2) ! !Config Key = LEAF_FRAC_HVC !Config Desc = parameters for herbivore activity !Config If = OK_STOMATE !Config Def = 0.33 !Config Help = !Config Units = CALL getin_p('LEAF_FRAC_HVC',leaf_frac_hvc) ! !Config Key = TLONG_REF_MAX !Config Desc = maximum reference long term temperature !Config If = OK_STOMATE !Config Def = 303.1 !Config Help = !Config Units = Kelvin [K] CALL getin_p('TLONG_REF_MAX',tlong_ref_max) ! !Config Key = TLONG_REF_MIN !Config Desc = minimum reference long term temperature !Config If = OK_STOMATE !Config Def = 253.1 !Config Help = !Config Units = Kelvin [K] CALL getin_p('TLONG_REF_MIN',tlong_ref_min) ! !Config Key = NCD_MAX_YEAR !Config Desc = !Config If = OK_STOMATE !Config Def = 3. !Config Help = !Config Units = CALL getin_p('NCD_MAX_YEAR',ncd_max_year) ! !Config Key = GDD_THRESHOLD !Config Desc = !Config If = OK_STOMATE !Config Def = 5. !Config Help = !Config Units = CALL getin_p('GDD_THRESHOLD',gdd_threshold) ! !Config Key = GREEN_AGE_EVER !Config Desc = !Config If = OK_STOMATE !Config Def = 2. !Config Help = !Config Units = CALL getin_p('GREEN_AGE_EVER',green_age_ever) ! !Config Key = GREEN_AGE_DEC !Config Desc = !Config If = OK_STOMATE !Config Def = 0.5 !Config Help = !Config Units = CALL getin_p('GREEN_AGE_DEC',green_age_dec) first_call = .FALSE. ENDIF END SUBROUTINE getin_stomate_parameters ! != ! SUBROUTINE getin_dgvm_parameters IMPLICIT NONE LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN !- ! establish parameters !- ! !Config Key = ESTAB_MAX_TREE !Config Desc = Maximum tree establishment rate !Config If = OK_DGVM !Config Def = 0.12 !Config Help = !Config Units = CALL getin_p('ESTAB_MAX_TREE',estab_max_tree) ! !Config Key = ESTAB_MAX_GRASS !Config Desc = Maximum grass establishment rate !Config If = OK_DGVM !Config Def = 0.12 !Config Help = !Config Units = CALL getin_p('ESTAB_MAX_GRASS',estab_max_grass) ! !Config Key = ESTABLISH_SCAL_FACT !Config Desc = !Config If = OK_DGVM !Config Def = 15. !Config Help = !Config Units = CALL getin_p('ESTABLISH_SCAL_FACT',establish_scal_fact) ! !Config Key = FPC_CRIT_MAX !Config Desc = !Config If = OK_DGVM !Config Def = 0.075 !Config Help = !Config Units = CALL getin_p('FPC_CRIT_MAX',fpc_crit_max) ! !Config Key = FPC_CRIT_MIN !Config Desc = !Config If = OK_DGVM !Config Def = 0.05 !Config Help = !Config Units = CALL getin_p('FPC_CRIT_MIN',fpc_crit_min) !- ! light parameters !- ! !Config Key = GRASS_MERCY !Config Desc = maximum total number of grass individuals in a closed canopy !Config If = OK_DGVM !Config Def = 0.01 !Config Help = !Config Units = CALL getin_p('GRASS_MERCY',grass_mercy) ! !Config Key = TREE_MERCY !Config Desc = minimum fraction of trees that survive even in a closed canopy !Config If = OK_DGVM !Config Def = 0.01 !Config Help = !Config Units = CALL getin_p('TREE_MERCY',tree_mercy) ! !Config Key = ANNUAL_INCREASE !Config Desc = for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or to fpc of last time step (F)? !Config If = OK_DGVM !Config Def = y !Config Help = !Config Units = NONE CALL getin_p('ANNUAL_INCREASE',annual_increase) ! !Config Key = MIN_COVER !Config Desc = For trees, minimum fraction of crown area occupied !Config If = OK_DGVM !Config Def = 0.05 !Config Help = !Config Units = CALL getin_p('MIN_COVER',min_cover) !- ! pftinout parameters !- ! !Config Key = IND_0 !Config Desc = initial density of individuals !Config If = OK_DGVM !Config Def = 0.02 !Config Help = !Config Units = CALL getin_p('IND_0',ind_0) ! !Config Key = MIN_AVAIL !Config Desc = minimum availability !Config If = OK_DGVM !Config Def = 0.01 !Config Help = !Config Units = CALL getin_p('MIN_AVAIL',min_avail) ! !Config Key = RIP_TIME_MIN !Config Desc = !Config If = OK_DGVM !Config Def = 1.25 !Config Help = !Config Units = CALL getin_p('RIP_TIME_MIN',RIP_time_min) ! !Config Key = NPP_LONGTERM_INIT !Config Desc = !Config If = OK_DGVM !Config Def = 10. !Config Help = !Config Units = CALL getin_p('NPP_LONGTERM_INIT',npp_longterm_init) ! !Config Key = EVERYWHERE_INIT !Config Desc = !Config If = OK_DGVM !Config Def = 0.05 !Config Help = !Config Units = CALL getin_p('EVERYWHERE_INIT',everywhere_init) first_call = .FALSE. ENDIF END SUBROUTINE getin_dgvm_parameters !-------------------- END MODULE constantes