! This subroutine calculates: ! 1-6 : leaf senescence, climatic and as a function of leaf age. New LAI. ! 7 : herbivores ! 8 : fruit turnover for trees. ! 9 : sapwood conversion. ! ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_turnover.f90,v 1.13 2010/04/06 15:44:01 ssipsl Exp $ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_turnover ! modules used: USE ioipsl USE stomate_constants USE constantes_veg IMPLICIT NONE ! private & public routines PRIVATE PUBLIC turn, turn_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE turn_clear firstcall=.TRUE. END SUBROUTINE turn_clear SUBROUTINE turn (npts, dt, PFTpresent, & herbivores, & maxmoiavail_lastyear, minmoiavail_lastyear, & moiavail_week, moiavail_month, tlong_ref, t2m_month, t2m_week, veget_max, & leaf_age, leaf_frac, age, lai, biomass, & turnover, senescence,turnover_time) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! time step in days REAL(r_std), INTENT(in) :: dt ! PFT exists LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent ! time constant of probability of a leaf to be eaten by a herbivore (days) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: herbivores ! last year's maximum moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxmoiavail_lastyear ! last year's minimum moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: minmoiavail_lastyear ! "weekly" moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_week ! "monthly" moisture availability REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_month ! "long term" 2 meter reference temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(in) :: tlong_ref ! "monthly" 2-meter temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_month ! "weekly" 2 meter temperatures (K) REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_week ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max ! 0.2 modified fields ! age of the leaves (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 ! age (years) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age ! leaf area index REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai ! biomass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass ! turnover_time of grasse REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: turnover_time ! 0.3 output ! Turnover rates (gC/day/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: turnover ! is the plant senescent? ! (interesting only for deciduous trees: carbohydrate reserve) LOGICAL, DIMENSION(npts,nvm), INTENT(out) :: senescence ! 0.4 local !!$ ! minimum leaf age for senescence (d) !!$ REAL(r_std), PARAMETER :: min_leaf_age = 30. ! mean age of the leaves (days) REAL(r_std), DIMENSION(npts,nvm) :: leaf_meanage ! Intermediate variable for turnover REAL(r_std), DIMENSION(npts) :: dturnover ! critical moisture availability, function of last year's moisture availability REAL(r_std), DIMENSION(npts) :: moiavail_crit ! long term annual mean temperature, C REAL(r_std), DIMENSION(npts) :: tl ! critical senescence temperature, function of long term annual temperature (K) REAL(r_std), DIMENSION(npts) :: t_crit ! shed the remaining leaves? LOGICAL, DIMENSION(npts) :: shed_rest ! Sapwood conversion (gC/day(m**2 of ground)) REAL(r_std), DIMENSION(npts) :: sapconv ! old heartwood mass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts) :: hw_old ! new heartwood mass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts) :: hw_new ! old leaf mass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts) :: lm_old ! leaf mass change for each age class REAL(r_std), DIMENSION(npts,nleafages) :: delta_lm ! turnover rate REAL(r_std), DIMENSION(npts) :: turnover_rate ! critical leaf age (d) REAL(r_std), DIMENSION(npts,nvm) :: leaf_age_crit ! instantaneous turnover time REAL(r_std), DIMENSION(npts,nvm) :: new_turnover_time ! Index INTEGER(i_std) :: j,m ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering turnover' ! ! 1 messages ! IF ( firstcall ) THEN WRITE(numout,*) 'turnover:' WRITE(numout,*) ' > minimum mean leaf age for senescence (d): ',pheno_crit%min_leaf_age_for_senescence firstcall = .FALSE. ENDIF ! ! 2 Initializations ! ! ! 2.1 set output to zero ! turnover(:,:,:) = zero new_turnover_time=zero senescence(:,:) = .FALSE. ! ! 2.2 mean leaf age. Should actually be recalculated at the end of this routine, ! but it does not change too fast. ! leaf_meanage(:,:) = 0.0 DO m = 1, nleafages leaf_meanage(:,:) = leaf_meanage(:,:) + leaf_age(:,:,m) * leaf_frac(:,:,m) ENDDO ! ! 3 different types of "climatic" leaf senescence ! does not change age structure. ! DO j = 2,nvm ! ! 3.1 determine if there is climatic senescence ! SELECT CASE ( pheno_crit%senescence_type(j) ) CASE ( 'cold' ) ! 3.1.1 summergreen species: ! monthly temperature low and temperature tendency negative ? ! critical temperature for senescence may depend on long term annual mean temperature tl(:) = tlong_ref(:) - ZeroCelsius t_crit(:) = ZeroCelsius + pheno_crit%senescence_temp(j,1) + & tl(:) * pheno_crit%senescence_temp(j,2) + & tl(:)*tl(:) * pheno_crit%senescence_temp(j,3) WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. & ( leaf_meanage(:,j) .GT. pheno_crit%min_leaf_age_for_senescence(j) ) .AND. & ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) ) senescence(:,j) = .TRUE. ENDWHERE CASE ( 'dry' ) ! 3.1.2 raingreen species: ! does moisture availability drop below critical level? moiavail_crit(:) = & MIN( MAX( minmoiavail_lastyear(:,j) + pheno_crit%hum_frac(j) * & ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), & pheno_crit%senescence_hum(j) ), & pheno_crit%nosenescence_hum(j) ) WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. & ( leaf_meanage(:,j) .GT. pheno_crit%min_leaf_age_for_senescence(j) ) .AND. & ( moiavail_week(:,j) .LT. moiavail_crit(:) ) ) senescence(:,j) = .TRUE. ENDWHERE CASE ( 'mixed' ) ! 3.1.3 mixed criterion: ! moisture availability drops below critical level, or ! monthly temperature low and temperature tendency negative moiavail_crit(:) = & MIN( MAX( minmoiavail_lastyear(:,j) + pheno_crit%hum_frac(j) * & ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), & pheno_crit%senescence_hum(j) ), & pheno_crit%nosenescence_hum(j) ) tl(:) = tlong_ref(:) - ZeroCelsius t_crit(:) = ZeroCelsius + pheno_crit%senescence_temp(j,1) + & tl(:) * pheno_crit%senescence_temp(j,2) + & tl(:)*tl(:) * pheno_crit%senescence_temp(j,3) IF ( tree(j) ) THEN ! critical temperature for senescence may depend on long term annual mean temperature WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. & ( leaf_meanage(:,j) .GT. pheno_crit%min_leaf_age_for_senescence(j) ) .AND. & ( ( moiavail_week(:,j) .LT. moiavail_crit(:) ) .OR. & ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) ) ) ) senescence(:,j) = .TRUE. ENDWHERE ELSE new_turnover_time(:,j)=pheno_crit%max_turnover_time(j)+20 WHERE ((moiavail_week(:,j) .LT. moiavail_month(:,j))& .AND. (moiavail_week(:,j) .LT. pheno_crit%nosenescence_hum(j))) new_turnover_time(:,j)=pheno_crit%max_turnover_time(j) * & (1.-pheno_crit%nosenescence_hum(j)+moiavail_week(:,j)) * & (1.-pheno_crit%nosenescence_hum(j)+moiavail_week(:,j)) + & pheno_crit%min_turnover_time(j) ! new_turnover_time(:,j)=pheno_crit%max_turnover_time(j) * & ! moiavail_week(:,j)/ pheno_crit%nosenescence_hum(j) + & ! pheno_crit%min_turnover_time(j) ENDWHERE ! WHERE ((t2m_month(:) .LT. t_crit(:)+5) .AND. ( t2m_week(:) .LT. t2m_month(:) )) ! new_turnover_time(:,j)=new_turnover_time(:,j)*((t2m_month(:)-t_crit(:))/5*0.4+0.6) ! ENDWHERE ! WHERE (new_turnover_time(:,j) .LT. pheno_crit%min_turnover_time(j)) ! new_turnover_time(:,j)=pheno_crit%min_turnover_time(j) ! ENDWHERE WHERE (new_turnover_time(:,j) .GT. turnover_time(:,j)*1.1) new_turnover_time(:,j)=pheno_crit%max_turnover_time(j)+20 ENDWHERE !!$ WHERE ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) & !!$ & .AND. ( leaf_meanage(:,j) .GT. pheno_crit%min_leaf_age_for_senescence(j) )) !!$ new_turnover_time(:,j)=pheno_crit%min_turnover_time(j) !!$ ENDWHERE ! print *,'t_crit=',t_crit turnover_time(:,j)=(turnover_time(:,j)*10./dt+new_turnover_time(:,j))/(10./dt+1.) ENDIF CASE ( 'none' ) ! evergreen species: no climatic senescence CASE default WRITE(numout,*) 'turnover: don''t know how to treat this PFT.' WRITE(numout,*) ' number: ',j WRITE(numout,*) ' senescence type: ',pheno_crit%senescence_type(j) STOP END SELECT ! ! 3.2 drop leaves and roots, plus stems and fruits for grasses ! IF ( tree(j) ) THEN ! 3.2.1 trees WHERE ( senescence(:,j) ) turnover(:,j,ileaf) = biomass(:,j,ileaf) * dt / pheno_crit%leaffall(j) turnover(:,j,iroot) = biomass(:,j,iroot) * dt / pheno_crit%leaffall(j) biomass(:,j,ileaf) = biomass(:,j,ileaf) - turnover(:,j,ileaf) biomass(:,j,iroot) = biomass(:,j,iroot) - turnover(:,j,iroot) ENDWHERE ELSE ! 3.2.2 grasses WHERE (turnover_time(:,j) .LT. pheno_crit%max_turnover_time(j)) turnover(:,j,ileaf) = biomass(:,j,ileaf) * dt / turnover_time(:,j) turnover(:,j,isapabove) = biomass(:,j,isapabove) * dt / turnover_time(:,j) turnover(:,j,iroot) = biomass(:,j,iroot) * dt / turnover_time(:,j) turnover(:,j,ifruit) = biomass(:,j,ifruit) * dt / turnover_time(:,j) ELSEWHERE turnover(:,j,ileaf)=0.0 turnover(:,j,isapabove) =0.0 turnover(:,j,iroot) = 0.0 turnover(:,j,ifruit) =0.0 ENDWHERE biomass(:,j,ileaf) = biomass(:,j,ileaf) - turnover(:,j,ileaf) biomass(:,j,isapabove) = biomass(:,j,isapabove) - turnover(:,j,isapabove) biomass(:,j,iroot) = biomass(:,j,iroot) - turnover(:,j,iroot) biomass(:,j,ifruit) = biomass(:,j,ifruit) - turnover(:,j,ifruit) ENDIF ! tree/grass ENDDO ! loop over PFTs ! ! 4 At a certain age, leaves fall off, even if the climate would allow a green plant ! all year round. ! Decay rate varies with leaf age. ! Roots, fruits (and stems) follow leaves. ! Note that plant is not declared senescent in this case (important for allocation: ! if the plant loses leaves because of their age, it can renew them). ! DO j = 2,nvm ! save old leaf mass lm_old(:) = biomass(:,j,ileaf) ! initialize leaf mass change in age class delta_lm(:,:) = 0.0 IF ( tree(j) ) THEN ! ! 4.1 trees: leaves, roots, fruits ! roots and fruits follow leaves. ! ! 4.1.1 critical age: prescribed for trees leaf_age_crit(:,j) = pheno_crit%leafagecrit(j) ! 4.1.2 loop over leaf age classes DO m = 1, nleafages turnover_rate(:) =0 WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. ) turnover_rate(:) = & MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * & ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**4._r_std ) ) dturnover(:) = biomass(:,j,ileaf) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:) biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:) ! save leaf mass change delta_lm(:,m) = - dturnover(:) dturnover(:) = biomass(:,j,iroot) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,iroot) = turnover(:,j,iroot) + dturnover(:) biomass(:,j,iroot) = biomass(:,j,iroot) - dturnover(:) dturnover(:) = biomass(:,j,ifruit) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:) biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:) ENDWHERE ENDDO ELSE ! ! 4.2 grasses: leaves, roots, fruits, sap. ! roots, fruits, and sap follow leaves. ! ! 4.2.1 critical leaf age depends on long-term temperature: ! generally, lower turnover in cooler climates. leaf_age_crit(:,j) = & MIN( pheno_crit%leafagecrit(j) * 1.5_r_std , & MAX( pheno_crit%leafagecrit(j) * 0.75_r_std, & pheno_crit%leafagecrit(j) - 10._r_std * & ( tlong_ref(:)-ZeroCelsius-20._r_std ) ) ) ! 4.2.2 loop over leaf age classes DO m = 1, nleafages WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. ) turnover_rate(:) = & MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * & ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**4._r_std ) ) dturnover(:) = biomass(:,j,ileaf) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:) biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:) ! save leaf mass change delta_lm(:,m) = - dturnover(:) dturnover(:) = biomass(:,j,isapabove) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,isapabove) = turnover(:,j,isapabove) + dturnover(:) biomass(:,j,isapabove) = biomass(:,j,isapabove) - dturnover(:) dturnover(:) = biomass(:,j,iroot) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,iroot) = turnover(:,j,iroot) + dturnover(:) biomass(:,j,iroot) = biomass(:,j,iroot) - dturnover(:) dturnover(:) = biomass(:,j,ifruit) * leaf_frac(:,j,m) * turnover_rate(:) turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:) biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:) ENDWHERE ENDDO ENDIF ! tree/grass ? ! ! 4.3 recalculate fraction in each leaf age class ! new fraction = new leaf mass of that fraction / new total leaf mass ! = ( old fraction*old total leaf mass + biomass change of that fraction ) / ! new total leaf mass ! DO m = 1, nleafages WHERE ( biomass(:,j,ileaf) .GT. 0.0 ) leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf) ELSEWHERE leaf_frac(:,j,m) = 0.0 ENDWHERE ENDDO ENDDO ! loop over PFTs ! ! 5 new (provisional) lai ! ! lai(:,ibare_sechiba) = zero ! DO j = 2, nvm ! lai(:,j) = biomass(:,j,ileaf) * sla(j) ! ENDDO ! ! 6 definitely drop leaves if very low leaf mass during senescence. ! Also drop fruits and loose fine roots. ! Set lai to zero if necessary ! Check whether leaf regrowth is immediately allowed. ! DO j = 2,nvm shed_rest(:) = .FALSE. ! ! 6.1 deciduous trees ! IF ( tree(j) .AND. ( pheno_crit%senescence_type(j) .NE. 'none' ) ) THEN ! check whether we shed the remaining leaves WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. senescence(:,j) .AND. & ( biomass(:,j,ileaf) .LT. (pheno_crit%lai_initmin(j) / 2.)/sla(j) ) ) shed_rest(:) = .TRUE. turnover(:,j,ileaf) = turnover(:,j,ileaf) + biomass(:,j,ileaf) turnover(:,j,iroot) = turnover(:,j,iroot) + biomass(:,j,iroot) turnover(:,j,ifruit) = turnover(:,j,ifruit) + biomass(:,j,ifruit) biomass(:,j,ileaf) = 0.0 biomass(:,j,iroot) = 0.0 biomass(:,j,ifruit) = 0.0 ! reset leaf age leaf_meanage(:,j) = 0.0 ENDWHERE ENDIF ! ! 6.2 grasses: also convert stems ! IF ( .NOT. tree(j) ) THEN ! Shed the remaining leaves if LAI very low. WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. senescence(:,j) .AND. & ( biomass(:,j,ileaf) .LT. (pheno_crit%lai_initmin(j) / 2.)/sla(j) )) shed_rest(:) = .TRUE. turnover(:,j,ileaf) = turnover(:,j,ileaf) + biomass(:,j,ileaf) turnover(:,j,isapabove) = turnover(:,j,isapabove) + biomass(:,j,isapabove) turnover(:,j,iroot) = turnover(:,j,iroot) + biomass(:,j,iroot) turnover(:,j,ifruit) = turnover(:,j,ifruit) + biomass(:,j,ifruit) biomass(:,j,ileaf) = 0.0 biomass(:,j,isapabove) = 0.0 biomass(:,j,iroot) = 0.0 biomass(:,j,ifruit) = 0.0 ! reset leaf age leaf_meanage(:,j) = 0.0 ENDWHERE ENDIF ! ! 6.3 reset leaf age structure ! DO m = 1, nleafages WHERE ( shed_rest(:) ) leaf_age(:,j,m) = 0.0 leaf_frac(:,j,m) = 0.0 ENDWHERE ENDDO ENDDO ! ! 7 Elephants, cows, gazelles. No lions. ! Does not modify leaf age structure. ! IF ( ok_herbivores ) THEN ! herbivore activity allowed. Eat when there are leaves. Otherwise, ! there won't be many fruits anyway. DO j = 2,nvm IF ( tree(j) ) THEN ! trees: only leaves and fruits are affected WHERE ( biomass(:,j,ileaf) .GT. zero ) ! added by shilong WHERE (herbivores(:,j).GT. zero) dturnover(:) = biomass(:,j,ileaf) * dt / herbivores(:,j) turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:) biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:) dturnover(:) = biomass(:,j,ifruit) * dt / herbivores(:,j) turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:) biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:) ENDWHERE ENDWHERE ELSE ! grasses: the whole biomass above the ground: leaves, fruits, stems WHERE ( biomass(:,j,ileaf) .GT. zero ) ! added by shilong WHERE (herbivores(:,j) .GT. zero) dturnover(:) = biomass(:,j,ileaf) * dt / herbivores(:,j) turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:) biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:) dturnover(:) = biomass(:,j,isapabove) * dt / herbivores(:,j) turnover(:,j,isapabove) = turnover(:,j,isapabove) + dturnover(:) biomass(:,j,isapabove) = biomass(:,j,isapabove) - dturnover(:) dturnover(:) = biomass(:,j,ifruit) * dt / herbivores(:,j) turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:) biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:) ENDWHERE ENDWHERE ENDIF ! tree/grass? ENDDO ! loop over PFTs ENDIF ! ! 8 fruit turnover for trees ! DO j = 2,nvm IF ( tree(j) ) THEN !SZ correction of a mass destroying bug dturnover(:) = biomass(:,j,ifruit) * dt / tau_fruit(j) turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:) biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:) !!$ turnover(:,j,ifruit) = biomass(:,j,ifruit) * dt / tau_fruit(j) !!$ biomass(:,j,ifruit) = biomass(:,j,ifruit) - turnover(:,j,ifruit) ENDIF ENDDO ! ! 9 Conversion of sapwood to heartwood ! This is not added to "turnover" as the biomass is not lost! ! DO j = 2,nvm IF ( tree(j) ) THEN ! for age calculations IF ( .NOT. control%ok_dgvm ) THEN hw_old(:) = biomass(:,j,iheartabove) + biomass(:,j,iheartbelow) ENDIF ! ! 9.1 Calculate the rate of conversion and update masses ! ! above the ground sapconv(:) = biomass(:,j,isapabove) * dt / tau_sap(j) biomass(:,j,isapabove) = biomass(:,j,isapabove) - sapconv(:) biomass(:,j,iheartabove) = biomass(:,j,iheartabove) + sapconv(:) ! below the ground sapconv(:) = biomass(:,j,isapbelow) * dt / tau_sap(j) biomass(:,j,isapbelow) = biomass(:,j,isapbelow) - sapconv(:) biomass(:,j,iheartbelow) = biomass(:,j,iheartbelow) + sapconv(:) ! ! 9.2 If vegetation is not dynamic, identify the age of the heartwood ! to the age of the whole tree (otherwise, the age of the tree is ! treated in the establishment routine). ! Creation of new heartwood decreases the age of the plant. ! IF ( .NOT. control%ok_dgvm ) THEN hw_new(:) = biomass(:,j,iheartabove) + biomass(:,j,iheartbelow) WHERE ( hw_new(:) .GT. 0.0 ) age(:,j) = age(:,j) * hw_old(:)/hw_new(:) ENDWHERE ENDIF ENDIF ENDDO ! ! history ! CALL histwrite (hist_id_stomate, 'LEAF_AGE', itime, & leaf_meanage, npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'HERBIVORES', itime, & herbivores, npts*nvm, horipft_index) IF (bavard.GE.4) WRITE(numout,*) 'Leaving turnover' END SUBROUTINE turn END MODULE stomate_turnover