! allocation to the roots, stems, leaves, "fruits" and carbohydrate reserve. ! Reproduction: for the moment, this is simply a 10% "tax". ! This should depend on the limitations that the plant experiences. If the ! plant fares well, it will have fruits. However, this means that we should ! also "reward" the plants for having grown fruits by making the ! reproduction rate depend on the fruit growth of the past years. Otherwise, ! the fruit allocation would be a punishment for plants that are doing well. ! "calculates" root profiles (in fact, prescribes it for the moment). ! ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_alloc.f90,v 1.10 2009/03/31 12:11:22 ssipsl Exp $ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_alloc ! modules used: USE ioipsl USE stomate_constants USE constantes_veg IMPLICIT NONE ! private & public routines PRIVATE PUBLIC alloc,alloc_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE alloc_clear firstcall = .TRUE. END SUBROUTINE alloc_clear SUBROUTINE alloc (npts, dt, & lai, veget_max, senescence, when_growthinit, & moiavail_week, tsoil_month, soilhum_month, & biomass, age, leaf_age, leaf_frac, rprof, f_alloc) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! time step (days) REAL(r_std), INTENT(in) :: dt ! Leaf area index REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai ! "maximal" coverage fraction of a PFT ( = ind*cn_ind ) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max ! is the plant senescent? (only for deciduous trees - carbohydrate reserve) LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: senescence ! how many days ago was the beginning of the growing season REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit ! "weekly" moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_week ! "monthly" soil temperature (K) REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_month ! "monthly" soil humidity REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_month ! age (days) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: age ! 0.2 modified fields ! biomass (gC/m**2) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass ! leaf age (days) REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age ! fraction of leaves in leaf age class REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac ! 0.3 output ! root depth. This will, one day, be a prognostic variable. It will be calculated by ! STOMATE (save in restart file & give to hydrology module!). For the moment, it ! is prescribed. REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: rprof ! fraction that goes into plant part REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: f_alloc ! 0.4 local ! Do we try to reach a minimum reservoir even if we are severely stressed? LOGICAL, PARAMETER :: ok_minres = .TRUE. ! time (d) to attain the initial foliage using the carbohydrate reserve REAL(r_std), PARAMETER :: tau_leafinit = 10. ! maximum time (d) during which reserve is used (trees) REAL(r_std), PARAMETER :: reserve_time_tree = 30. ! maximum time (d) during which reserve is used (grasses) REAL(r_std), PARAMETER :: reserve_time_grass = 20. ! Standard root allocation REAL(r_std), PARAMETER :: R0 = 0.3 ! Standard sapwood allocation REAL(r_std), PARAMETER :: S0 = 0.3 ! Standard leaf allocation REAL(r_std), PARAMETER :: L0 = 1. - R0 - S0 ! Standard fruit allocation REAL(r_std), PARAMETER :: f_fruit = 0.1 ! fraction of sapwood allocation above ground (SHOULD BE CALCULATED !!!!) REAL(r_std), PARAMETER :: alloc_sap_above_tree = 0.5 REAL(r_std), PARAMETER :: alloc_sap_above_grass = 1.0 ! extrema of leaf allocation fraction REAL(r_std), PARAMETER :: min_LtoLSR = 0.2 REAL(r_std), PARAMETER :: max_LtoLSR = 0.5 ! below this lai, the carbohydrate reserve is used REAL(r_std), DIMENSION(nvm) :: lai_happy ! limiting factor light REAL(r_std), DIMENSION(npts) :: limit_L ! limiting factor nitrogen REAL(r_std), DIMENSION(npts) :: limit_N ! factors determining limit_N: 1/ temperature REAL(r_std), DIMENSION(npts) :: limit_N_temp ! factors determining limit_N: 2/ humidity REAL(r_std), DIMENSION(npts) :: limit_N_hum ! limiting factor water REAL(r_std), DIMENSION(npts) :: limit_W ! limiting factor in soil (nitrogen or water) REAL(r_std), DIMENSION(npts) :: limit_WorN ! limit: strongest limitation amongst limit_N, limit_W and limit_L REAL(r_std), DIMENSION(npts) :: limit ! scaling depth for nitrogen limitation (m) REAL(r_std), PARAMETER :: z_nitrogen = 0.2 ! soil temperature used for N parameterization REAL(r_std), DIMENSION(npts) :: t_nitrogen ! soil humidity used for N parameterization REAL(r_std), DIMENSION(npts) :: h_nitrogen ! integration constant for vertical profiles REAL(r_std), DIMENSION(npts) :: rpc ! ratio between leaf-allocation and (leaf+sapwood+root)-allocation REAL(r_std), DIMENSION(npts) :: LtoLSR ! ratio between sapwood-allocation and (leaf+sapwood+root)-allocation REAL(r_std), DIMENSION(npts) :: StoLSR ! ratio between root-allocation and (leaf+sapwood+root)-allocation REAL(r_std), DIMENSION(npts) :: RtoLSR ! rescaling factor for carbohydrate reserve allocation REAL(r_std), DIMENSION(npts) :: carb_rescale ! mass taken from carbohydrate reserve (gC/m**2) REAL(r_std), DIMENSION(npts) :: use_reserve ! mass taken from carbohydrate reserve and put into leaves (gC/m**2) REAL(r_std), DIMENSION(npts) :: transloc_leaf ! mass in youngest leaf age class (gC/m**2) REAL(r_std), DIMENSION(npts) :: leaf_mass_young ! old leaf biomass (gC/m**2) REAL(r_std), DIMENSION(npts,nvm) :: lm_old ! maximum time (d) during which reserve is used REAL(r_std) :: reserve_time ! lai on natural part of the grid cell, or of this agricultural PFT REAL(r_std), DIMENSION(npts,nvm) :: lai_around ! vegetation cover of natural PFTs on the grid cell (agriculture masked) REAL(r_std), DIMENSION(npts,nvm) :: veget_max_nat ! total natural vegetation cover on natural part of the grid cell REAL(r_std), DIMENSION(npts) :: natveg_tot ! average LAI on natural part of the grid cell REAL(r_std), DIMENSION(npts) :: lai_nat ! intermediate array for looking for minimum REAL(r_std), DIMENSION(npts) :: zdiff_min ! fraction of sapwood allocation above ground (SHOULD BE CALCULATED !!!!) REAL(r_std), DIMENSION(npts) :: alloc_sap_above ! soil levels (m) REAL(r_std), SAVE, DIMENSION(0:nbdl) :: z_soil ! Index INTEGER(i_std) :: i,j,l,m ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering alloc' ! ! 1 Initialization ! ! ! 1.1 first call ! IF ( firstcall ) THEN ! 1.1.1 soil levels z_soil(0) = 0. z_soil(1:nbdl) = diaglev(1:nbdl) ! 1.1.2 info about flags and parameters. WRITE(numout,*) 'alloc:' WRITE(numout,'(a,$)') ' > We' IF ( .NOT. ok_minres ) WRITE(numout,'(a,$)') ' do NOT' WRITE(numout,*) 'try to reach a minumum reservoir when severely stressed.' WRITE(numout,*) ' > Time to put initial leaf mass on (d): ',tau_leafinit WRITE(numout,*) ' > scaling depth for nitrogen limitation (m): ', & z_nitrogen WRITE(numout,*) ' > sap allocation above the ground / total sap allocation: ' WRITE(numout,*) ' trees:', alloc_sap_above_tree WRITE(numout,*) ' grasses:', alloc_sap_above_grass WRITE(numout,*) ' > standard root alloc fraction: ', R0 WRITE(numout,*) ' > standard sapwood alloc fraction: ', S0 WRITE(numout,*) ' > standard fruit allocation: ', f_fruit WRITE(numout,*) ' > minimum/maximum leaf alloc fraction: ', min_LtoLSR,max_LtoLSR WRITE(numout,*) ' > maximum time (d) during which reserve is used:' WRITE(numout,*) ' trees:',reserve_time_tree WRITE(numout,*) ' grasses:',reserve_time_grass firstcall = .FALSE. ENDIF ! ! 1.2 initialize output ! f_alloc(:,:,:) = 0.0 f_alloc(:,:,icarbres) = 1.0 ! ! 1.3 Convolution of the temperature and humidity profiles with some kind of profile ! of microbial density gives us a representative temperature and humidity ! ! 1.3.1 temperature ! 1.3.1.1 rpc is an integration constant such that the integral of the root profile is 1. rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) ) ! 1.3.1.2 integrate over the nbdl levels t_nitrogen(:) = 0. DO l = 1, nbdl t_nitrogen(:) = & t_nitrogen(:) + tsoil_month(:,l) * rpc(:) * & ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) ) ENDDO ! 1.3.2 moisture ! 1.3.2.1 rpc is an integration constant such that the integral of the root profile is 1. rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) ) ! 1.3.2.2 integrate over the nbdl levels h_nitrogen(:) = 0.0 DO l = 1, nbdl h_nitrogen(:) = & h_nitrogen(:) + soilhum_month(:,l) * rpc(:) * & ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) ) ENDDO ! ! 1.4 for light limitation: lai on natural part of the grid cell or lai of this ! agricultural PFT ! ! mask agricultural vegetation ! mean LAI on natural part natveg_tot(:) = 0.0 lai_nat(:) = 0.0 DO j = 2, nvm IF ( natural(j) ) THEN veget_max_nat(:,j) = veget_max(:,j) ELSE veget_max_nat(:,j) = 0.0 ENDIF ! sum up fraction of natural space covered by vegetation natveg_tot(:) = natveg_tot(:) + veget_max_nat(:,j) ! sum up lai lai_nat(:) = lai_nat(:) + veget_max_nat(:,j) * lai(:,j) ENDDO DO j = 2, nvm IF ( natural(j) ) THEN lai_around(:,j) = lai_nat(:) ELSE lai_around(:,j) = lai(:,j) ENDIF ENDDO ! ! 1.5 LAI below which carbohydrate reserve is used ! lai_happy(:) = lai_max(:) * 0.5 ! ! 2 Use carbohydrate reserve ! This time constant implicitly takes into account the dispersion of the budburst ! data. Therefore, it might be decreased at lower resolution. ! ! save old leaf mass lm_old(:,:) = biomass(:,:,ileaf) DO j = 2, nvm ! ! 2.1 determine mass to be translocated to leaves and roots ! ! determine maximum time during which reserve is used IF ( tree(j) ) THEN reserve_time = reserve_time_tree ELSE reserve_time = reserve_time_grass ENDIF ! conditions: 1/ plant must not be senescent ! 2/ lai must be relatively low ! 3/ must be at the beginning of the growing season WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. & ( .NOT. senescence(:,j) ) .AND. & ( lai(:,j) .LT. lai_happy(j) ) .AND. & ( when_growthinit(:,j) .LT. reserve_time ) ) ! determine mass to put on use_reserve(:) = & MIN( biomass(:,j,icarbres), & 2._r_std * dt/tau_leafinit * lai_happy(j)/ sla(j) ) ! grow leaves and fine roots transloc_leaf(:) = L0/(L0+R0) * use_reserve(:) biomass(:,j,ileaf) = biomass(:,j,ileaf) + transloc_leaf(:) biomass(:,j,iroot) = biomass(:,j,iroot) + ( use_reserve(:) - transloc_leaf(:) ) ! decrease reserve mass biomass(:,j,icarbres) = biomass(:,j,icarbres) - use_reserve(:) ELSEWHERE transloc_leaf(:) = 0.0 ENDWHERE ! ! 2.2 update leaf age ! ! 2.2.1 Decrease leaf age in youngest class. leaf_mass_young(:) = leaf_frac(:,j,1) * lm_old(:,j) + transloc_leaf(:) WHERE ( ( transloc_leaf(:) .GT. min_stomate ) .AND. ( leaf_mass_young(:) .GT. min_stomate ) ) leaf_age(:,j,1) = MAX( zero, leaf_age(:,j,1) * ( leaf_mass_young(:) - transloc_leaf(:) ) / & leaf_mass_young(:) ) ENDWHERE ! 2.2.2 new age class fractions (fraction in youngest class increases) ! 2.2.2.1 youngest class: new mass in youngest class divided by total new mass WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf) ENDWHERE ! 2.2.2.2 other classes: old mass in leaf age class divided by new mass DO m = 2, nleafages WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf) ENDWHERE ENDDO ENDDO ! loop over PFTs ! ! 3 Calculate fractional allocation. ! The fractions of NPP allocated to the different compartments depend on the ! availability of light, water, and nitrogen. ! DO j = 2, nvm RtoLSR(:)=0 LtoLSR(:)=0 StoLSR(:)=0 ! for the moment, fixed partitioning between above and below the ground ! modified by JO/NV/PF for changing partitioning with stand age ! we could have alloc_sap_above(npts,nvm) but we have only ! alloc_sap_above(npts) as we make a loop over j=2,nvm ! IF ( tree(j) ) THEN alloc_sap_above (:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(1.-EXP(-age(:,j)/demi_alloc(j))) !IF (j .EQ. 3) WRITE(*,*) '%allocated above = 'alloc_sap_above(1),'age = ',age(1,j) ELSE alloc_sap_above(:) = alloc_sap_above_grass ENDIF ! only where leaves are on WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) ! ! 3.1 Limiting factors: weak value = strong limitation ! ! 3.1.1 Light: depends on mean lai on the natural part of the ! grid box (light competition). ! For agricultural PFTs, take its own lai for both parts. !MM, NV WHERE( lai_around(:,j) < 10 ) limit_L(:) = MAX( 0.1_r_std, EXP( -0.5_r_std * lai_around(:,j) ) ) ELSEWHERE limit_L(:) = 0.1_r_std ENDWHERE ! 3.1.2 Water limit_W(:) = MAX( 0.1_r_std, MIN( 1._r_std, moiavail_week(:,j) ) ) ! 3.1.3 Nitrogen supply: depends on water and temperature ! Agricultural PFTs can be limited by Nitrogen for the moment ... ! Replace this once there is a nitrogen cycle in STOMATE ! ! 3.1.3.1 water limit_N_hum(:) = MAX( 0.5_r_std, MIN( 1._r_std, h_nitrogen(:) ) ) ! 3.1.3.2 temperature limit_N_temp(:) = 2.**((t_nitrogen(:)-ZeroCelsius-25.)/10.) limit_N_temp(:) = MAX( 0.1_r_std, MIN( 1._r_std, limit_N_temp(:) ) ) ! 3.1.3.3 combine water and temperature factors to get nitrogen limitation limit_N(:) = MAX( 0.1_r_std, MIN( 1._r_std, limit_N_hum(:) * limit_N_temp(:) ) ) ! 3.1.4 Among water and nitrogen, take the one that is more limited limit_WorN(:) = MIN( limit_W(:), limit_N(:) ) ! 3.1.5 strongest limitation limit(:) = MIN( limit_WorN(:), limit_L(:) ) ! ! 3.2 Ratio between allocation to leaves, sapwood and roots ! ! preliminary root allocation RtoLSR(:) = & MAX( .15_r_std, & R0 * 3._r_std * limit_L(:) / ( limit_L(:) + 2._r_std * limit_WorN(:) ) ) ! sapwood allocation StoLSR(:) = S0 * 3. * limit_WorN(:) / ( 2. * limit_L(:) + limit_WorN(:) ) ! leaf allocation LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:) LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) ) ! roots: the rest RtoLSR(:) = 1. - LtoLSR(:) - StoLSR(:) ENDWHERE ! no leaf allocation if LAI beyond maximum LAI. Biomass then goes into sapwood WHERE ( (biomass(:,j,ileaf) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) ) StoLSR(:) = StoLSR(:) + LtoLSR(:) LtoLSR(:) = 0.0 ENDWHERE ! ! 3.3 final allocation ! DO i = 1, npts IF ( biomass(i,j,ileaf) .GT. min_stomate ) THEN IF ( senescence(i,j) ) THEN ! 3.3.1 senescent: everything goes into carbohydrate reserve f_alloc(i,j,icarbres) = 1.0 ELSE ! 3.3.2 in growing season ! to fruits f_alloc(i,j,ifruit) = f_fruit ! allocation to the reserve is proportional to the leaf and root allocation. ! Leaf, root, and sap allocation are rescaled. ! No allocation to reserve if there is much biomass in it ! (more than the maximum LAI: in that case, rescale=1) IF ( ( biomass(i,j,icarbres)*sla(j) ) .LT. 2*lai_max(j) ) THEN carb_rescale(i) = 1. / ( 1. + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) ) ELSE carb_rescale(i) = 1. ENDIF f_alloc(i,j,ileaf) = LtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i) f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * & ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i) f_alloc(i,j,isapbelow) = StoLSR(i) * ( 1. - alloc_sap_above(i) ) * & ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i) f_alloc(i,j,iroot) = RtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i) ! this is equivalent to: ! reserve alloc = ecureuil*(LtoLSR+StoLSR)*(1-fruit_alloc)*carb_rescale f_alloc(i,j,icarbres) = ( 1. - carb_rescale(i) ) * ( 1.-f_alloc(i,j,ifruit) ) ENDIF ! senescent? ENDIF ! there are leaves ENDDO ! Fortran95: double WHERE construct ENDDO ! loop over PFTs ! ! 4 root profile ! IF (bavard.GE.4) WRITE(numout,*) 'Leaving alloc' END SUBROUTINE alloc END MODULE stomate_alloc