! 09/2010 ! This is the module where we define the number of pfts and the values of the ! parameters ! author : D.Solyga MODULE pft_parameters USE constantes_mtc USE constantes USE ioipsl USE defprec IMPLICIT NONE !------------------------- ! PFT global !------------------------ ! Number of vegetation types (see constantes_veg) INTEGER(i_std) :: nvm = 13 !- !Table of conversion : we associate one pft to one mtc INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pft_to_mtc !- ! Description of the PFT CHARACTER(len=34), ALLOCATABLE, SAVE, DIMENSION (:) :: PFT_name ! ! Flag l_first_define_pft LOGICAL, SAVE :: l_first_define_pft = .TRUE. !---------------------- ! Vegetation structure !---------------------- !- ! 1 .Sechiba !- ! Value for veget_ori for tests in 0-dim simulations REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: veget_ori_fixed_test_1 ! laimax for maximum lai see also type of lai interpolation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: llaimax ! laimin for minimum lai see also type of lai interpolation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: llaimin ! prescribed height of vegetation. ! Value for height_presc : one for each vegetation type REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: height_presc ! Type of behaviour of the LAI evolution algorithm ! for each vegetation type. ! Value of type_of_lai, one for each vegetation type : mean or interp CHARACTER(len=5),ALLOCATABLE, SAVE, DIMENSION (:) :: type_of_lai ! Is the vegetation type a tree ? LOGICAL,ALLOCATABLE, SAVE, DIMENSION (:) :: is_tree !- ! 2 .Stomate !- ! leaf type ! 1=broad leaved tree, 2=needle leaved tree, 3=grass 4=bared ground INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leaf_tab ! specif leaf area (m**2/gC) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: sla ! natural? LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: natural !---------------- ! Photosynthesis !---------------- !- ! 1 .CO2 !- ! flag for C4 vegetation types LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: is_c4 ! Slope of the gs/A relation (Ball & al.) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: gsslope ! intercept of the gs/A relation (Ball & al.) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: gsoffset ! values used for vcmax when STOMATE is not activated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vcmax_fix ! values used for vjmax when STOMATE is not activated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vjmax_fix ! values used for photosynthesis tmin when STOMATE is not activated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: co2_tmin_fix ! values used for photosynthesis topt when STOMATE is not activated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: co2_topt_fix ! values used for photosynthesis tmax when STOMATE is not activated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: co2_tmax_fix !- ! 2 .Stomate !- ! extinction coefficient of the Monsi&Seaki relationship (1953) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ext_coeff ! = ext_coef in sechiba ! Maximum rate of carboxylation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vcmax_opt ! Maximum rate of RUbp regeneration REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vjmax_opt ! minimum photosynthesis temperature, ! constant a of ax^2+bx+c (deg C),tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_min_a ! minimum photosynthesis temperature, ! constant b of ax^2+bx+c (deg C),tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_min_b ! minimum photosynthesis temperature, ! constant c of ax^2+bx+c (deg C),tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_min_c ! optimum photosynthesis temperature, ! constant a of ax^2+bx+c (deg C),tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_opt_a ! optimum photosynthesis temperature, ! constant b of ax^2+bx+c (deg C),tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_opt_b ! optimum photosynthesis temperature, ! constant c of ax^2+bx+c (deg C),tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_opt_c ! maximum photosynthesis temperature, ! constant a of ax^2+bx+c (deg C), tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_max_a ! maximum photosynthesis temperature, ! constant b of ax^2+bx+c (deg C), tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_max_b ! maximum photosynthesis temperature, ! constant c of ax^2+bx+c (deg C), tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tphoto_max_c !----------------------- ! Respiration - stomate !----------------------- ! !-! slope of maintenance respiration coefficient (1/K, 1/K^2, 1/K^3), used in the code REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: maint_resp_slope ! slope of maintenance respiration coefficient (1/K), ! constant c of aT^2+bT+c , tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: maint_resp_slope_c ! slope of maintenance respiration coefficient (1/K), ! constant b of aT^2+bT+c , tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: maint_resp_slope_b ! slope of maintenance respiration coefficient (1/K), ! constant a of aT^2+bT+c , tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: maint_resp_slope_a !- ! maintenance respiration coefficient (g/g/day) at 0 deg C, used in the code REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: coeff_maint_zero ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for leaves, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_leaf ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for sapwood above, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_sapabove ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for sapwood below, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_sapbelow ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for heartwood above, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_heartabove ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for heartwood below, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_heartbelow ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for roots, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_root ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for fruits, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cm_zero_fruit ! maintenance respiration coefficient (g/g/day) at 0 deg C, ! for carbohydrate reserve, tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) ::cm_zero_carbres !---------------- ! Fire - stomate !---------------- ! flamability: critical fraction of water holding capacity REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: flam ! fire resistance REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: resist !--------------- ! Flux - LUC !--------------- ! ! Coeff of biomass export for the year REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: coeff_lcchange_1 ! Coeff of biomass export for the decade REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: coeff_lcchange_10 ! Coeff of biomass export for the century REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: coeff_lcchange_100 !----------- ! Phenology !----------- !- ! 1 .Stomate !- ! ! maximum LAI, PFT-specific REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lai_max ! which phenology model is used? (tabulated) CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_model ! type of phenology ! 0=bared ground 1=evergreen, 2=summergreen, 3=raingreen, 4=perennial ! Pour l'instant, le phénotype de sol nu n'est pas géré aussi on traitera les sols INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_type !- ! 2. Leaf Onset !- !-! critical gdd,tabulated (C), used in the code REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pheno_gdd_crit ! critical gdd,tabulated (C), constant c of aT^2+bT+c REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_gdd_crit_c ! critical gdd,tabulated (C), constant b of aT^2+bT+c REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_gdd_crit_b ! critical gdd,tabulated (C), constant a of aT^2+bT+c REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pheno_gdd_crit_a ! critical ngd,tabulated. Threshold -5 degrees REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ngd_crit ! critical temperature for the ncd vs. gdd function in phenology REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ncdgdd_temp ! critical humidity (relative to min/max) for phenology REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: hum_frac ! minimum duration of dormance (d) for phenology REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lowgpp_time ! minimum time elapsed since moisture minimum (d) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: hum_min_time ! sapwood -> heartwood conversion time (d) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tau_sap ! fruit lifetime (d) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tau_fruit ! fraction of primary leaf and root allocation put into reserve REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ecureuil ! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alloc_min REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alloc_max REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: demi_alloc !- ! 3. Senescence !- ! length of death of leaves,tabulated (d) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leaffall ! critical leaf age,tabulated (d) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leafagecrit ! type of senescence,tabulated ! List of avaible types of senescence : ! 'cold ', 'dry ', 'mixed ', 'none ' CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_type ! critical relative moisture availability for senescence REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_hum ! relative moisture availability above which ! there is no humidity-related senescence REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: nosenescence_hum ! maximum turnover time for grasse REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: max_turnover_time ! minimum turnover time for grasse REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: min_turnover_time ! minimum leaf age to allow senescence g REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: min_leaf_age_for_senescence !-! critical temperature for senescence (C), used in the code REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: senescence_temp ! critical temperature for senescence (C), ! constant c of aT^2+bT+c , tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_temp_c ! critical temperature for senescence (C), ! constant b of aT^2+bT+c , tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_temp_b ! critical temperature for senescence (C), ! constant a of aT^2+bT+c , tabulated REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: senescence_temp_a !----------- ! DGVM !----------- !- ! residence time (y) of trees REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: residence_time ! critical tmin, tabulated (C) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmin_crit ! critical tcm, tabulated (C) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tcm_crit !------------------------------- ! Evapotranspiration - sechiba !------------------------------- !- ! Structural resistance. ! Value for rstruct_const : one for each vegetation type REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: rstruct_const ! ! A vegetation dependent constant used in the calculation ! of the surface resistance. ! Value for kzero one for each vegetation type REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: kzero !------------------- ! Water - sechiba !------------------- !- ! Maximum field capacity for each of the vegetations (Temporary). ! Value of wmax_veg : max quantity of water : ! one for each vegetation type en Kg/M3 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: wmax_veg ! Root profile description for the different vegetation types. ! These are the factor in the exponential which gets ! the root density as a function of depth REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: humcste !------------------ ! Albedo - sechiba !------------------ !- ! Initial snow albedo value for each vegetation type ! as it will be used in condveg_snow ! Values are from the Thesis of S. Chalita (1992) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snowa_ini ! ! Decay rate of snow albedo value for each vegetation type ! as it will be used in condveg_snow ! Values are from the Thesis of S. Chalita (1992) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snowa_dec ! ! leaf albedo of vegetation type, visible albedo REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alb_leaf_vis ! leaf albedo of vegetation type, near infrared albedo REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alb_leaf_nir ! leaf albedo of vegetation type, VIS+NIR REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: alb_leaf ! !------------------------ ! Soil - vegetation !------------------------ ! Table which contains the correlation between the soil types ! and vegetation type. Two modes exist : ! 1) pref_soil_veg = 0 then we have an equidistribution ! of vegetation on soil types ! 2) Else for each pft the prefered soil type is given : ! 1=sand, 2=loan, 3=clay ! The variable is initialized in slowproc. INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pref_soil_veg INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pref_soil_veg_sand INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pref_soil_veg_loan INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pref_soil_veg_clay ! !-------------------------------------------- ! Internal parameters used in stomate_data !------------------------------------------- ! REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lai_initmin ! is pft a tree LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: tree ! sapling biomass (gC/ind) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: bm_sapl ! migration speed (m/year) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: migrate ! maximum stem diameter from which on crown area no longer increases (m)m REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: maxdia ! crown of tree when sapling (m**2) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: cn_sapl ! time constant for leaf age discretisation (d) REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: leaf_timecst !------------------------------- ! Parameters already externalised (from sechiba) ! to classify !---------------------------------- ! ! used in hydrolc REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: throughfall_by_pft ! used in diffuco !! Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout !! d'un potentiometre pour regler la resistance de la vegetation REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: rveg_pft CONTAINS ! SUBROUTINE pft_main ! Local INTEGER(i_std) :: i !---------------------- ! PFT global !---------------------- IF(l_first_define_pft) THEN IF(long_print) THEN WRITE(numout,*) 'l_first_define_pft :we read the parameters from the def files' ENDIF ! Allocation of memory for the pfts-parameters CALL pft_alloc ! Initialisation of the correspondance table pft_to_mtc (:) = zero_int ! Reading of the conrrespondance table in the .def file CALL getin('PFT_TO_MTC',pft_to_mtc) ! What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)? DO i = 1, nvm IF(pft_to_mtc(i) .GT. nvmc) THEN WRITE(numout,*) "the MTC you chose doesn't exist" STOP 'we stop reading pft_to_mtc' ENDIF ENDDO ! Verify if pft_to_mtc(1) = 1 IF(pft_to_mtc(1) .NE. 1) THEN WRITE(numout,*) 'the first pft has to be the bare soil' STOP 'we stop reading next values of pft_to_mtc' ELSE DO i = 2,nvm IF(pft_to_mtc(i) .EQ.1) THEN WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil' STOP 'we stop reading pft_to_mtc' ENDIF ENDDO ENDIF ! Initialisation of the pfts-parameters CALL pft_init ! Could be useful : correspondance between the number of the pft ! and the name of the associated mtc DO i = 1,nvm WRITE(numout,*) 'the PFT',i,'corresponds to the MTC : ',PFT_name(i) ENDDO !------------------------------------------------------! ! Declaration of tables 2D which are used in the code ! !------------------------------------------------------! ! !- pheno_gdd_crit pheno_gdd_crit(:,:) = zero pheno_gdd_crit(:,1) = pheno_gdd_crit_c pheno_gdd_crit(:,2) = pheno_gdd_crit_b pheno_gdd_crit(:,3) = pheno_gdd_crit_a ! !- senescence_temp senescence_temp(:,:) = zero senescence_temp(:,1) = senescence_temp_c senescence_temp(:,2) = senescence_temp_b senescence_temp(:,3) = senescence_temp_a ! !- maint_resp_slope maint_resp_slope(:,:) = zero maint_resp_slope(:,1)= maint_resp_slope_c maint_resp_slope(:,2) = maint_resp_slope_b maint_resp_slope(:,3) = maint_resp_slope_a ! !-coeff_maint_zero coeff_maint_zero (:,:) = zero coeff_maint_zero(:,ileaf) = cm_zero_leaf coeff_maint_zero(:,isapabove) = cm_zero_sapabove coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow coeff_maint_zero(:,iheartabove) = cm_zero_heartabove coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow coeff_maint_zero(:,iroot) = cm_zero_root coeff_maint_zero(:,ifruit) = cm_zero_fruit coeff_maint_zero(:,icarbres) = cm_zero_carbres ! !-alb_leaf alb_leaf(1:nvm) = alb_leaf_vis(1:nvm) DO i = nvm+1, 2*nvm alb_leaf(i) = alb_leaf_nir(i-nvm) ENDDO !- pref_soil_veg (see slowproc) ELSE l_first_define_pft = .FALSE. RETURN ENDIF END SUBROUTINE pft_main ! != ! SUBROUTINE pft_init !------------ ! local INTEGER(i_std) :: j,k !------------ ! Initialisation !! not all the parameters are initialized !---------------------- ! Vegetation structure !---------------------- !- ! 1 .Sechiba !- veget_ori_fixed_test_1 = zero llaimax(:) = zero llaimin(:) = zero height_presc(:) = zero !- ! 2 .Stomate ! leaf_tab(:) = zero_int sla(:) = zero !---------------- ! Photosynthesis !---------------- !- ! 1 .CO2 !- gsslope(:) = zero gsoffset(:) = zero vcmax_fix(:) = zero vjmax_fix(:) = zero co2_tmin_fix(:) = zero co2_topt_fix(:) = zero co2_tmax_fix(:) = zero !- ! 2 .Stomate !- ext_coeff(:) = zero vcmax_opt(:) = zero vjmax_opt(:) = zero tphoto_min_a(:) = zero tphoto_min_b(:) = zero tphoto_min_c(:) = zero tphoto_opt_a(:) = zero tphoto_opt_b(:) = zero tphoto_opt_c(:) = zero tphoto_max_a(:) = zero tphoto_max_b(:) = zero tphoto_max_c(:) = zero !---------------------- ! Respiration - stomate !---------------------- ! maint_resp_slope_c(:) = zero maint_resp_slope_b(:) = zero maint_resp_slope_a(:) = zero cm_zero_leaf(:) = zero cm_zero_sapabove(:) = zero cm_zero_sapbelow(:) = zero cm_zero_heartabove(:) = zero cm_zero_heartbelow(:) = zero cm_zero_root(:) = zero cm_zero_fruit(:) = zero cm_zero_carbres(:) = zero !---------------- ! Fire - stomate !--------------- ! flam(:) = zero resist(:) = zero !---------------- ! Flux - LUC !--------------- ! coeff_lcchange_1(:) = zero coeff_lcchange_10(:) = zero coeff_lcchange_100(:) = zero ! !----------- ! Phenology !----------- !- ! 1 .Stomate !- lai_max(:) = zero pheno_type(:) = zero_int !- ! 2. Leaf Onset !- pheno_gdd_crit_c(:) = zero pheno_gdd_crit_b(:) = zero pheno_gdd_crit_a(:) = zero ngd_crit(:) = zero ncdgdd_temp(:) = zero hum_frac(:) = zero lowgpp_time(:) = zero hum_min_time(:) = zero tau_sap(:) = zero tau_fruit(:) = zero ecureuil(:) = zero alloc_min(:) = zero alloc_max(:) = zero demi_alloc(:) = zero !- ! 3. Senescence !- leaffall(:) = zero leafagecrit(:) = zero senescence_hum(:) = zero nosenescence_hum(:) = zero max_turnover_time(:) = zero min_turnover_time(:) = zero min_leaf_age_for_senescence(:) = zero senescence_temp_c(:) = zero senescence_temp_b(:) = zero senescence_temp_a(:) = zero !----------- ! DGVM !----------- ! residence_time(:) = zero tmin_crit(:) = zero tcm_crit(:) = zero !------------------------------- ! Evapotranspiration - sechiba !------------------------------- !- rstruct_const(:) = zero kzero(:) = zero !------------------- ! Water - sechiba !------------------- !- wmax_veg(:) = zero humcste(:) = zero !------------------ ! Albedo - sechiba !------------------ !- snowa_ini(:) = zero snowa_dec(:) = zero alb_leaf_vis(:) = zero alb_leaf_nir(:) = zero alb_leaf(:) = zero !------------------------ ! Soil - vegetation !------------------------ pref_soil_veg(:,:) = zero_int !------------------------ ! Internal_parameters !------------------------ lai_initmin(:) = zero bm_sapl(:,:) = zero migrate(:) = zero maxdia(:) = zero cn_sapl(:) = zero leaf_timecst(:) = zero !------------------------------- ! Parameters already externalised (from sechiba) ! to classify !---------------------------------- throughfall_by_pft(:) = zero rveg_pft(:) = zero !-------------------------------------------------------------! ! Correspondance between the PFTs values and thes MTCs values ! !-------------------------------------------------------------! DO j= 1, nvm PFT_name(j) = MTC_name(pft_to_mtc(j)) !---------------------- ! Vegetation structure !---------------------- !- ! 1 .Sechiba !- veget_ori_fixed_test_1(j) = veget_ori_fixed_mtc(pft_to_mtc(j)) llaimax(j) = llaimax_mtc(pft_to_mtc(j)) llaimin(j) = llaimin_mtc(pft_to_mtc(j)) height_presc(j) = height_presc_mtc(pft_to_mtc(j)) type_of_lai(j) = type_of_lai_mtc(pft_to_mtc(j)) is_tree(j) = is_tree_mtc(pft_to_mtc(j)) !- ! 2 .Stomate !- leaf_tab(j) = leaf_tab_mtc(pft_to_mtc(j)) sla(j) = sla_mtc(pft_to_mtc(j)) natural(j) = natural_mtc(pft_to_mtc(j)) !---------------- ! Photosynthesis !---------------- !- ! 1 .CO2 !- is_c4(j) = is_c4_mtc(pft_to_mtc(j)) gsslope(j) = gsslope_mtc(pft_to_mtc(j)) gsoffset(j) = gsoffset_mtc(pft_to_mtc(j)) vcmax_fix(j) = vcmax_fix_mtc(pft_to_mtc(j)) vjmax_fix(j) = vjmax_fix_mtc(pft_to_mtc(j)) co2_tmin_fix(j) = co2_tmin_fix_mtc(pft_to_mtc(j)) co2_topt_fix(j) = co2_topt_fix_mtc(pft_to_mtc(j)) co2_tmax_fix(j) = co2_tmax_fix_mtc(pft_to_mtc(j)) !- ! 2 .Stomate !- ext_coeff(j) = ext_coeff_mtc(pft_to_mtc(j)) vcmax_opt(j) = vcmax_opt_mtc(pft_to_mtc(j)) vjmax_opt(j) = vjmax_opt_mtc(pft_to_mtc(j)) tphoto_min_a(j) = tphoto_min_a_mtc(pft_to_mtc(j)) tphoto_min_b(j) = tphoto_min_b_mtc(pft_to_mtc(j)) tphoto_min_c(j) = tphoto_min_c_mtc(pft_to_mtc(j)) tphoto_opt_a(j) = tphoto_opt_a_mtc(pft_to_mtc(j)) tphoto_opt_b(j) = tphoto_opt_b_mtc(pft_to_mtc(j)) tphoto_opt_c(j) = tphoto_opt_c_mtc(pft_to_mtc(j)) tphoto_max_a(j) = tphoto_max_a_mtc(pft_to_mtc(j)) tphoto_max_b(j) = tphoto_max_b_mtc(pft_to_mtc(j)) tphoto_max_c(j) = tphoto_max_c_mtc(pft_to_mtc(j)) !---------------------- ! Respiration - stomate !---------------------- maint_resp_slope_c = maint_resp_slope_c_mtc(pft_to_mtc(j)) maint_resp_slope_b = maint_resp_slope_b_mtc(pft_to_mtc(j)) maint_resp_slope_a = maint_resp_slope_a_mtc(pft_to_mtc(j)) cm_zero_leaf(j)= cm_zero_leaf_mtc(pft_to_mtc(j)) cm_zero_sapabove(j) = cm_zero_sapabove_mtc(pft_to_mtc(j)) cm_zero_sapbelow(j) = cm_zero_sapbelow_mtc(pft_to_mtc(j)) cm_zero_heartabove(j) = cm_zero_heartabove_mtc(pft_to_mtc(j)) cm_zero_heartbelow(j) = cm_zero_heartbelow_mtc(pft_to_mtc(j)) cm_zero_root(j) =cm_zero_root_mtc(pft_to_mtc(j)) cm_zero_fruit(j) =cm_zero_fruit_mtc(pft_to_mtc(j)) cm_zero_carbres(j) = cm_zero_carbres_mtc(pft_to_mtc(j)) !---------------- ! Fire - stomate !--------------- flam(j) = flam_mtc(pft_to_mtc(j)) resist(j) = resist_mtc(pft_to_mtc(j)) !---------------- ! Flux - LUC !--------------- coeff_lcchange_1(j) = coeff_lcchange_1_mtc(pft_to_mtc(j)) coeff_lcchange_10(j) = coeff_lcchange_10_mtc(pft_to_mtc(j)) coeff_lcchange_100(j) = coeff_lcchange_100_mtc(pft_to_mtc(j)) !----------- ! Phenology !----------- !- ! 1 .Stomate !- lai_max(j) = lai_max_mtc(pft_to_mtc(j)) pheno_model(j) = pheno_model_mtc(pft_to_mtc(j)) pheno_type(j) = pheno_type_mtc(pft_to_mtc(j)) !- ! 2. Leaf Onset !- pheno_gdd_crit_c(j) = pheno_gdd_crit_c_mtc(pft_to_mtc(j)) pheno_gdd_crit_b(j) = pheno_gdd_crit_b_mtc(pft_to_mtc(j)) pheno_gdd_crit_a(j) = pheno_gdd_crit_a_mtc(pft_to_mtc(j)) ngd_crit(j) = ngd_crit_mtc(pft_to_mtc(j)) ncdgdd_temp(j) = ncdgdd_temp_mtc(pft_to_mtc(j)) hum_frac(j) = hum_frac_mtc(pft_to_mtc(j)) lowgpp_time(j) = lowgpp_time_mtc(pft_to_mtc(j)) hum_min_time(j) = hum_min_time_mtc(pft_to_mtc(j)) tau_sap(j) =tau_sap_mtc(pft_to_mtc(j)) tau_fruit(j) =tau_fruit_mtc(pft_to_mtc(j)) ecureuil(j) = ecureuil_mtc(pft_to_mtc(j)) alloc_min(j) = alloc_min_mtc(pft_to_mtc(j)) alloc_max(j) = alloc_max_mtc(pft_to_mtc(j)) demi_alloc(j) = demi_alloc_mtc(pft_to_mtc(j)) !- ! 3. Senescence !- leaffall(j) = leaffall_mtc(pft_to_mtc(j)) leafagecrit(j) = leafagecrit_mtc(pft_to_mtc(j)) senescence_type(j) = senescence_type_mtc(pft_to_mtc(j)) senescence_hum(j) = senescence_hum_mtc(pft_to_mtc(j)) nosenescence_hum(j) = nosenescence_hum_mtc(pft_to_mtc(j)) max_turnover_time(j) = max_turnover_time_mtc(pft_to_mtc(j)) min_turnover_time(j) = min_turnover_time_mtc(pft_to_mtc(j)) min_leaf_age_for_senescence(j) = min_leaf_age_for_senescence_mtc(pft_to_mtc(j)) senescence_temp_c(j) = senescence_temp_c_mtc(pft_to_mtc(j)) senescence_temp_b(j) = senescence_temp_b_mtc(pft_to_mtc(j)) senescence_temp_a(j) = senescence_temp_a_mtc(pft_to_mtc(j)) !----------- ! DGVM !----------- residence_time(j) = residence_time_mtc(pft_to_mtc(j)) tmin_crit(j) = tmin_crit_mtc(pft_to_mtc(j)) tcm_crit(j) = tcm_crit_mtc(pft_to_mtc(j)) !------------------------------- ! Evapotranspiration - sechiba !------------------------------- !- rstruct_const(j) = rstruct_const_mtc(pft_to_mtc(j)) kzero(j) = kzero_mtc(pft_to_mtc(j)) !------------------- ! Water - sechiba !------------------- !- wmax_veg(j) = wmax_veg_mtc(pft_to_mtc(j)) humcste(j) = humcste_mtc(pft_to_mtc(j)) !------------------ ! Albedo - sechiba !------------------ !- snowa_ini(j) = snowa_ini_mtc(pft_to_mtc(j)) snowa_dec(j) = snowa_dec_mtc(pft_to_mtc(j)) alb_leaf_vis(j) = alb_leaf_vis_mtc(pft_to_mtc(j)) alb_leaf_nir(j) = alb_leaf_nir_mtc(pft_to_mtc(j)) !------------------------ ! Soil - vegetation !------------------------ pref_soil_veg_sand(j) = pref_soil_veg_sand_mtc(pft_to_mtc(j)) pref_soil_veg_loan(j) = pref_soil_veg_loan_mtc(pft_to_mtc(j)) pref_soil_veg_clay(j) = pref_soil_veg_clay_mtc(pft_to_mtc(j)) !------------------------------- ! Parameters already externalised (from sechiba) ! to classify !---------------------------------- throughfall_by_pft(j) = throughfall_by_mtc(pft_to_mtc(j)) rveg_pft(j) = rveg_mtc(pft_to_mtc(j)) ENDDO END SUBROUTINE pft_init ! != ! SUBROUTINE pft_alloc !------------------ ! local LOGICAL :: l_error INTEGER :: ier !----------------- l_error = .FALSE. ALLOCATE(pft_to_mtc(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(PFT_name(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(veget_ori_fixed_test_1(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(llaimax(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(llaimin(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(height_presc(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(type_of_lai(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(is_tree(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(leaf_tab(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(sla(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(natural(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(is_c4(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(gsslope(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(gsoffset(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(vcmax_fix(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(vjmax_fix(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(co2_tmin_fix(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(co2_topt_fix(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(co2_tmax_fix(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(ext_coeff(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(vcmax_opt(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(vjmax_opt(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_min_a(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_min_b(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_min_c(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_opt_a(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_opt_b(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_opt_c(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_max_a(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_max_b(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tphoto_max_c(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(pheno_gdd_crit_c(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pheno_gdd_crit_b(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pheno_gdd_crit_a(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pheno_gdd_crit(nvm,3),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(ngd_crit(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(ncdgdd_temp(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(hum_frac(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(lowgpp_time(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(hum_min_time(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tau_sap(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tau_fruit(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(ecureuil(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(alloc_min(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(alloc_max(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(demi_alloc(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(maint_resp_slope(nvm,3),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(maint_resp_slope_c(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(maint_resp_slope_b(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(maint_resp_slope_a(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(coeff_maint_zero(nvm,nparts),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_leaf(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_sapabove(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_sapbelow(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_heartabove(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_heartbelow(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_root(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_fruit(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cm_zero_carbres(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(flam(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(resist(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(coeff_lcchange_1(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(coeff_lcchange_10(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(coeff_lcchange_100(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(lai_max(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pheno_model(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pheno_type(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(leaffall(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(leafagecrit(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(senescence_type(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(senescence_hum(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(nosenescence_hum(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(max_turnover_time(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(min_turnover_time(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(min_leaf_age_for_senescence(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(senescence_temp_c(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(senescence_temp_b(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(senescence_temp_a(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(senescence_temp(nvm,3),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(residence_time(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tmin_crit(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tcm_crit(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(rstruct_const(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(kzero(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(wmax_veg(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(humcste(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(snowa_ini(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(snowa_dec(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(alb_leaf_vis(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(alb_leaf_nir(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(alb_leaf(2*nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(pref_soil_veg_sand(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pref_soil_veg_loan(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pref_soil_veg_clay(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(pref_soil_veg(nvm,nstm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(lai_initmin(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(tree(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(bm_sapl(nvm,nparts),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(migrate(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(maxdia(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(cn_sapl(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE(leaf_timecst(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) !- ALLOCATE(throughfall_by_pft(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) ALLOCATE (rveg_pft(nvm),stat=ier) l_error = l_error .OR. (ier .NE. 0) IF (l_error) THEN STOP 'pft _alloc : error in memory allocation' ENDIF END SUBROUTINE pft_alloc ! != ! SUBROUTINE pft_clear l_first_define_pft = .TRUE. IF(ALLOCATED(pft_to_mtc))DEALLOCATE(pft_to_mtc) IF(ALLOCATED(PFT_name))DEALLOCATE(PFT_name) !- IF(ALLOCATED(veget_ori_fixed_test_1))DEALLOCATE(veget_ori_fixed_test_1) IF(ALLOCATED(llaimax))DEALLOCATE(llaimax) IF(ALLOCATED(llaimin))DEALLOCATE(llaimin) IF(ALLOCATED(height_presc))DEALLOCATE(height_presc) IF(ALLOCATED(type_of_lai))DEALLOCATE(type_of_lai) IF(ALLOCATED(is_tree))DEALLOCATE(is_tree) !- IF(ALLOCATED(leaf_tab))DEALLOCATE(leaf_tab) IF(ALLOCATED(sla))DEALLOCATE(sla) IF(ALLOCATED(natural))DEALLOCATE(natural) !- IF(ALLOCATED(is_c4))DEALLOCATE(is_c4) IF(ALLOCATED(gsslope))DEALLOCATE(gsslope) IF(ALLOCATED(gsoffset))DEALLOCATE(gsoffset) IF(ALLOCATED(vcmax_fix))DEALLOCATE(vcmax_fix) IF(ALLOCATED(vjmax_fix))DEALLOCATE(vjmax_fix) IF(ALLOCATED(co2_tmin_fix))DEALLOCATE(co2_tmin_fix) IF(ALLOCATED(co2_topt_fix))DEALLOCATE(co2_topt_fix) IF(ALLOCATED(co2_tmax_fix))DEALLOCATE(co2_tmax_fix) !- IF(ALLOCATED(ext_coeff))DEALLOCATE(ext_coeff) IF(ALLOCATED(vcmax_opt))DEALLOCATE(vcmax_opt) IF(ALLOCATED(vjmax_opt))DEALLOCATE(vjmax_opt) IF(ALLOCATED(tphoto_min_a))DEALLOCATE(tphoto_min_a) IF(ALLOCATED(tphoto_min_b))DEALLOCATE(tphoto_min_b) IF(ALLOCATED(tphoto_min_c))DEALLOCATE(tphoto_min_c) IF(ALLOCATED(tphoto_opt_a))DEALLOCATE(tphoto_opt_a) IF(ALLOCATED(tphoto_opt_b))DEALLOCATE(tphoto_opt_b) IF(ALLOCATED(tphoto_opt_c))DEALLOCATE(tphoto_opt_c) IF(ALLOCATED(tphoto_max_a))DEALLOCATE(tphoto_max_a) IF(ALLOCATED(tphoto_max_b))DEALLOCATE(tphoto_max_b) IF(ALLOCATED(tphoto_max_c))DEALLOCATE(tphoto_max_c) !- IF(ALLOCATED(maint_resp_slope))DEALLOCATE(maint_resp_slope) IF(ALLOCATED(maint_resp_slope_c))DEALLOCATE(maint_resp_slope_c) IF(ALLOCATED(maint_resp_slope_b))DEALLOCATE(maint_resp_slope_b) IF(ALLOCATED(maint_resp_slope_a))DEALLOCATE(maint_resp_slope_a) IF(ALLOCATED(coeff_maint_zero))DEALLOCATE(coeff_maint_zero) IF(ALLOCATED(cm_zero_leaf))DEALLOCATE(cm_zero_leaf) IF(ALLOCATED(cm_zero_sapabove))DEALLOCATE(cm_zero_sapabove) IF(ALLOCATED(cm_zero_sapbelow))DEALLOCATE(cm_zero_sapbelow) IF(ALLOCATED(cm_zero_heartabove))DEALLOCATE(cm_zero_heartabove) IF(ALLOCATED(cm_zero_heartbelow))DEALLOCATE(cm_zero_heartbelow) IF(ALLOCATED(cm_zero_root))DEALLOCATE(cm_zero_root) IF(ALLOCATED(cm_zero_fruit))DEALLOCATE(cm_zero_fruit) IF(ALLOCATED(cm_zero_carbres))DEALLOCATE(cm_zero_carbres) !- IF(ALLOCATED(flam))DEALLOCATE(flam) IF(ALLOCATED(resist))DEALLOCATE(resist) !- IF(ALLOCATED(coeff_lcchange_1))DEALLOCATE(coeff_lcchange_1) IF(ALLOCATED(coeff_lcchange_10))DEALLOCATE(coeff_lcchange_10) IF(ALLOCATED(coeff_lcchange_100))DEALLOCATE(coeff_lcchange_100) !- IF(ALLOCATED(lai_max)) DEALLOCATE(lai_max) IF(ALLOCATED(pheno_model))DEALLOCATE(pheno_model) IF(ALLOCATED(pheno_type))DEALLOCATE(pheno_type) !- IF(ALLOCATED(pheno_gdd_crit_c))DEALLOCATE(pheno_gdd_crit_c) IF(ALLOCATED(pheno_gdd_crit_b))DEALLOCATE(pheno_gdd_crit_b) IF(ALLOCATED(pheno_gdd_crit_a))DEALLOCATE(pheno_gdd_crit_a) IF(ALLOCATED(pheno_gdd_crit))DEALLOCATE(pheno_gdd_crit) IF(ALLOCATED(ngd_crit))DEALLOCATE(ngd_crit) IF(ALLOCATED(ncdgdd_temp))DEALLOCATE(ncdgdd_temp) IF(ALLOCATED(hum_frac))DEALLOCATE(hum_frac) IF(ALLOCATED(lowgpp_time))DEALLOCATE(lowgpp_time) IF(ALLOCATED(hum_min_time))DEALLOCATE(hum_min_time) IF(ALLOCATED(tau_sap))DEALLOCATE(tau_sap) IF(ALLOCATED(tau_fruit))DEALLOCATE(tau_fruit) IF(ALLOCATED(ecureuil))DEALLOCATE(ecureuil) IF(ALLOCATED(alloc_min))DEALLOCATE(alloc_min) IF(ALLOCATED(alloc_max))DEALLOCATE(alloc_max) IF(ALLOCATED(demi_alloc))DEALLOCATE(demi_alloc) !- IF(ALLOCATED(leaffall))DEALLOCATE(leaffall) IF(ALLOCATED(leafagecrit))DEALLOCATE(leafagecrit) IF(ALLOCATED(senescence_type))DEALLOCATE(senescence_type) IF(ALLOCATED(senescence_hum))DEALLOCATE(senescence_hum) IF(ALLOCATED(nosenescence_hum))DEALLOCATE(nosenescence_hum) IF(ALLOCATED(max_turnover_time))DEALLOCATE(max_turnover_time) IF(ALLOCATED(min_turnover_time))DEALLOCATE(min_turnover_time) IF(ALLOCATED(min_leaf_age_for_senescence))DEALLOCATE(min_leaf_age_for_senescence) !- IF(ALLOCATED(senescence_temp_c))DEALLOCATE(senescence_temp_c) IF(ALLOCATED(senescence_temp_b))DEALLOCATE(senescence_temp_b) IF(ALLOCATED(senescence_temp_a))DEALLOCATE(senescence_temp_a) IF(ALLOCATED(senescence_temp))DEALLOCATE(senescence_temp) !- IF(ALLOCATED(residence_time))DEALLOCATE(residence_time) IF(ALLOCATED(tmin_crit))DEALLOCATE(tmin_crit) IF(ALLOCATED(tcm_crit))DEALLOCATE(tcm_crit) !- IF(ALLOCATED(rstruct_const))DEALLOCATE(rstruct_const) IF(ALLOCATED(kzero))DEALLOCATE(kzero) !- IF(ALLOCATED(wmax_veg))DEALLOCATE(wmax_veg) IF(ALLOCATED(humcste))DEALLOCATE(humcste) !- IF(ALLOCATED(snowa_ini))DEALLOCATE(snowa_ini) IF(ALLOCATED(snowa_dec))DEALLOCATE(snowa_dec) IF(ALLOCATED(alb_leaf_vis))DEALLOCATE(alb_leaf_vis) IF(ALLOCATED(alb_leaf_nir))DEALLOCATE(alb_leaf_nir) IF(ALLOCATED(alb_leaf))DEALLOCATE(alb_leaf) !- IF(ALLOCATED(pref_soil_veg_sand))DEALLOCATE(pref_soil_veg_sand) IF(ALLOCATED(pref_soil_veg_loan))DEALLOCATE(pref_soil_veg_loan) IF(ALLOCATED(pref_soil_veg_clay))DEALLOCATE(pref_soil_veg_clay) IF(ALLOCATED(pref_soil_veg))DEALLOCATE(pref_soil_veg) !- IF(ALLOCATED(lai_initmin))DEALLOCATE(lai_initmin) IF(ALLOCATED(tree))DEALLOCATE(tree) IF(ALLOCATED(bm_sapl))DEALLOCATE(bm_sapl) IF(ALLOCATED(migrate))DEALLOCATE(migrate) IF(ALLOCATED(maxdia))DEALLOCATE(maxdia) IF(ALLOCATED(cn_sapl))DEALLOCATE(cn_sapl) IF(ALLOCATED(leaf_timecst))DEALLOCATE(leaf_timecst) !- IF(ALLOCATED(throughfall_by_pft))DEALLOCATE(throughfall_by_pft) IF (ALLOCATED(rveg_pft))DEALLOCATE(rveg_pft) END SUBROUTINE pft_clear SUBROUTINE getin_sechiba_pft_parameters LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN !---------------------- ! Vegetation structure !--------------------- ! CALL getin('LLAIMIN',llaimin) CALL getin('TYPE_OF_LAI',type_of_lai) CALL getin('IS_TREE',is_tree) ! No calling to getin for ! veget_ori_fixed_test_1, llaimax and height_presc ! getin will be called in slowproc.f90 !----------------- ! Photosynthesis !----------------- !- CALL getin('IS_C4',is_c4) CALL getin('GSSLOPE',gsslope) CALL getin('GSOFFSET',gsoffset) CALL getin('VCMAX_FIX',vcmax_fix) CALL getin('VJMAX_FIX',vjmax_fix) CALL getin('CO2_TMIN_FIX',co2_tmin_fix) CALL getin('CO2_TOPT_FIX',co2_topt_fix) CALL getin('CO2_TMAX_FIX',co2_tmax_fix) CALL getin('EXT_COEFF',ext_coeff) !------------------------------- ! Evapotranspiration - sechiba !------------------------------- ! CALL getin('RSTRUCT_CONST',rstruct_const) CALL getin('KZERO',kzero) !------------------- ! Water - sechiba !------------------- ! CALL getin('WMAX_VEG',wmax_veg) ! humcste is called in slowproc.f90 (problem with the flag) !------------------ ! Albedo - sechiba !------------------ ! CALL getin('SNOWA_INI',snowa_ini) CALL getin('SNOWA_DEC',snowa_dec) CALL getin('ALB_LEAF_VIS',alb_leaf_vis) CALL getin('ALB_LEAF_NIR',alb_leaf_nir) !------------------------ ! Soil - vegetation !------------------------ ! CALL getin('PREF_SOIL_VEG_SAND',pref_soil_veg_sand) CALL getin('PREF_SOIL_VEG_LOAN',pref_soil_veg_loan) CALL getin('PREF_SOIL_VEG_CLAY',pref_soil_veg_clay) ENDIF END SUBROUTINE getin_sechiba_pft_parameters SUBROUTINE getin_stomate_pft_parameters LOGICAL, SAVE :: first_call = .TRUE. IF(first_call) THEN !---------------------- ! Vegetation structure !--------------------- ! CALL getin('LEAF_TAB',leaf_tab) CALL getin('SLA',sla) CALL getin('NATURAL',natural) !----------------- ! Photosynthesis !----------------- ! CALL getin('VCMAX_OPT',vcmax_opt) CALL getin('VJMAX_OPT',vjmax_opt) CALL getin('TPHOTO_MIN_A',tphoto_min_a) CALL getin('TPHOTO_MIN_B',tphoto_min_b) CALL getin('TPHOTO_MIN_C',tphoto_min_c) CALL getin('TPHOTO_OPT_A',tphoto_opt_a) CALL getin('TPHOTO_OPT_B',tphoto_opt_b) CALL getin('TPHOTO_OPT_C',tphoto_opt_c) CALL getin('TPHOTO_MAX_A',tphoto_max_a) CALL getin('TPHOTO_MAX_B',tphoto_max_b) CALL getin('TPHOTO_MAX_C',tphoto_max_c) !---------------------- ! Respiration - stomate !---------------------- ! CALL getin('MAINT_RESP_SLOPE_C',maint_resp_slope_c) CALL getin('MAINT_RESP_SLOPE_B',maint_resp_slope_b) CALL getin('MAINT_RESP_SLOPE_A',maint_resp_slope_a) CALL getin('CM_ZERO_LEAF',cm_zero_leaf) CALL getin('CM_ZERO_SAPABOVE',cm_zero_sapabove) CALL getin('CM_ZERO_SAPBELOW',cm_zero_sapbelow) CALL getin('CM_ZERO_HEARTABOVE',cm_zero_heartabove) CALL getin('CM_ZERO_HEARTBELOW',cm_zero_heartbelow) CALL getin('CM_ZERO_ROOT',cm_zero_root) CALL getin('CM_ZERO_FRUIT',cm_zero_fruit) CALL getin('CM_ZERO_CARBRES',cm_zero_carbres) !---------------- ! Fire - stomate !--------------- ! CALL getin('FLAM',flam) CALL getin('RESIST',resist) !---------------- ! Flux - LUC !--------------- ! CALL getin('COEFF_LCCHANGE_1',coeff_lcchange_1) CALL getin('COEFF_LCCHANGE_10',coeff_lcchange_10) CALL getin('COEFF_LCCHANGE_100',coeff_lcchange_100) !----------- ! Phenology !----------- !- ! 1 .Stomate !- CALL getin('LAI_MAX',lai_max) CALL getin('PHENO_MODEL',pheno_model) CALL getin('PHENO_TYPE',pheno_type) !- ! 2. Leaf Onset !- CALL getin('PHENO_GDD_CRIT_C',pheno_gdd_crit_c) CALL getin('PHENO_GDD_CRIT_B',pheno_gdd_crit_b) CALL getin('PHENO_GDD_CRIT_A',pheno_gdd_crit_a) CALL getin('NGD_CRIT',ngd_crit) CALL getin('NCDGDD_TEMP', ncdgdd_temp) CALL getin('HUM_FRAC', hum_frac) CALL getin('LOWGPP_TIME', lowgpp_time) CALL getin('HUM_MIN_TIME', hum_min_time) CALL getin('TAU_SAP',tau_sap) CALL getin('TAU_FRUIT',tau_fruit) CALL getin('ECUREUIL',ecureuil) CALL getin('ALLOC_MIN',alloc_min) CALL getin('ALLOC_MAX',alloc_max) CALL getin('DEMI_ALLOC',demi_alloc) !- ! 3. Senescence !- CALL getin('LEAFFALL',leaffall) CALL getin('LEAFAGECRIT',leafagecrit) CALL getin('SENESCENCE_TYPE', senescence_type) CALL getin('SENESCENCE_HUM', senescence_hum) CALL getin('NOSENESCENCE_HUM', nosenescence_hum) CALL getin('MAX_TURNOVER_TIME',max_turnover_time) CALL getin('MIN_TURNOVER_TIME',min_turnover_time) CALL getin('MIN_LEAF_AGE_FOR_SENESCENCE', min_leaf_age_for_senescence) CALL getin('SENESCENCE_TEMP_C',senescence_temp_c) CALL getin('SENESCENCE_TEMP_B',senescence_temp_b) CALL getin('SENESCENCE_TEMP_A',senescence_temp_a) !----------- ! DGVM !----------- CALL getin('RESIDENCE_TIME',residence_time) CALL getin('TMIN_CRIT',tmin_crit) CALL getin('TCM_CRIT',tcm_crit) ENDIF END SUBROUTINE getin_stomate_pft_parameters END MODULE pft_parameters