! Npp: Maintenance and growth respiration ! We calculte first the maintenance rspiration. This is substracted from the ! allocatable biomass (and from the present biomass if the GPP is too low). ! Of the rest, a part is lost as growth respiration, while the other part is ! effectively allocated. ! ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_npp.f90,v 1.14 2010/04/20 14:12:04 ssipsl Exp $ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_npp ! modules used: USE ioipsl USE stomate_data USE constantes USE pft_parameters IMPLICIT NONE ! private & public routines PRIVATE PUBLIC npp_calc,npp_calc_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE npp_calc_clear firstcall=.TRUE. END SUBROUTINE npp_calc_clear SUBROUTINE npp_calc (npts, dt, & PFTpresent, & tlong_ref, t2m, tsoil, lai, rprof, & gpp, f_alloc, bm_alloc, resp_maint_part,& biomass, leaf_age, leaf_frac, age, & resp_maint, resp_growth, npp) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! time step (days) REAL(r_std), INTENT(in) :: dt ! PFT exists LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent ! long term annual mean 2 meter reference temperature REAL(r_std), DIMENSION(npts), INTENT(in) :: tlong_ref ! 2 meter temperature REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m ! soil temperature (K) REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil ! leaf area index REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai ! root depth (m) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: rprof ! gross primary productivity (gC/days/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gpp ! fraction that goes into plant part REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: f_alloc ! maintenance respiration of different plant parts (gC/day/m**2 of ground) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: resp_maint_part ! 0.2 modified fields ! biomass (gC/(m**2 of ground)) 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 ! age (years) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age ! 0.3 output ! maintenance respiration (gC/day/m**2 of total ground) REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_maint ! autotrophic respiration (gC/day/m**2 of total ground) REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_growth ! net primary productivity (gC/day/m**2 of ground) REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: npp ! biomass increase, i.e. NPP per plant part REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: bm_alloc ! 0.4 local ! soil levels (m) REAL(r_std), SAVE, DIMENSION(0:nbdl) :: z_soil ! root temperature (convolution of root and soil temperature profiles) REAL(r_std), DIMENSION(npts,nvm) :: t_root ! maintenance respiration coefficients at 0 deg C (g/g d**-1) REAL(r_std), DIMENSION(npts,nvm,nparts) :: coeff_maint ! temperature which is pertinent for maintenance respiration (K) REAL(r_std), DIMENSION(npts,nparts) :: t_maint ! integration constant for root profile REAL(r_std), DIMENSION(npts) :: rpc ! long term annual mean temperature, C REAL(r_std), DIMENSION(npts) :: tl ! slope of maintenance respiration coefficient (1/K) REAL(r_std), DIMENSION(npts) :: slope ! growth respiration of different plant parts (gC/day/m**2 of ground) REAL(r_std), DIMENSION(npts,nparts) :: resp_growth_part ! allocatable biomass (gC/m**2 of ground) for the whole plant REAL(r_std), DIMENSION(npts,nvm) :: bm_alloc_tot ! biomass increase REAL(r_std), DIMENSION(npts) :: bm_add ! new biomass REAL(r_std), DIMENSION(npts) :: bm_new ! leaf mass in youngest age class (gC/m**2 of ground) REAL(r_std), DIMENSION(npts,nvm) :: leaf_mass_young ! leaf mass after maintenance respiration REAL(r_std), DIMENSION(npts,nvm) :: lm_old ! biomass created when biomass<0 because of dark respiration (gC/m**2 of ground) REAL(r_std), DIMENSION(npts,nvm) :: bm_create ! maximum part of allocatable biomass used for respiration REAL(r_std), DIMENSION(npts) :: bm_tax_max ! biomass that remains to be taken away REAL(r_std), DIMENSION(npts) :: bm_pump ! Index INTEGER(i_std) :: i,j,k,l,m ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering npp' ! ! 1 Initializations ! ! ! 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 messages WRITE(numout,*) 'npp:' WRITE(numout,*) ' > max. fraction of allocatable biomass used for'// & ' maint. resp.:', tax_max firstcall = .FALSE. ENDIF ! ! 1.2 set output to zero ! bm_alloc(:,:,:) = zero resp_maint(:,:) = zero resp_growth(:,:) = zero npp(:,:) = zero ! ! 1.3 root temperature: convolution of root and temperature profiles ! suppose exponential root profile. ! DO j = 2,nvm ! 1.3.1 rpc is an integration constant such that the integral of the root profile is 1. rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / rprof(:,j) ) ) ! 1.3.2 integrate over the nbdl levels t_root(:,j) = zero DO l = 1, nbdl t_root(:,j) = & t_root(:,j) + tsoil(:,l) * rpc(:) * & ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) ENDDO ENDDO ! ! 1.4 total allocatable biomass ! bm_alloc_tot(:,:) = gpp(:,:) * dt ! ! 2 define maintenance respiration coefficients ! DO j = 2,nvm ! ! 2.1 temperature which is taken for the plant part we are talking about ! ! 2.1.1 parts above the ground t_maint(:,ileaf) = t2m(:) t_maint(:,isapabove) = t2m(:) t_maint(:,ifruit) = t2m(:) ! 2.1.2 parts below the ground t_maint(:,isapbelow) = t_root(:,j) t_maint(:,iroot) = t_root(:,j) ! 2.1.3 heartwood: does not respire. Any temperature t_maint(:,iheartbelow) = t_root(:,j) t_maint(:,iheartabove) = t2m(:) ! 2.1.4 reserve: above the ground for trees, below for grasses IF ( tree(j) ) THEN t_maint(:,icarbres) = t2m(:) ELSE t_maint(:,icarbres) = t_root(:,j) ENDIF ! ! 2.2 calculate coefficient ! tl(:) = tlong_ref(:) - ZeroCelsius slope(:) = maint_resp_slope(j,1) + tl(:) * maint_resp_slope(j,2) + & tl(:)*tl(:) * maint_resp_slope(j,3) DO k = 1, nparts coeff_maint(:,j,k) = & MAX( coeff_maint_zero(j,k) * & ( 1. + slope(:) * (t_maint(:,k)-ZeroCelsius) ), zero ) ENDDO ENDDO ! ! 3 calculate maintenance and growth respiration. ! NPP = GPP - maintenance resp - growth resp. ! ! DO j = 2,nvm ! ! 3.1 maintenance respiration of the different plant parts ! ! ! 3.2 Total maintenance respiration of the plant ! VPP killer: ! resp_maint(:,j) = SUM( resp_maint_part(:,:), DIM=2 ) ! resp_maint(:,j) = zero ! with the new calculation of hourly respiration, we must verify that ! PFT has not been killed after calcul of resp_maint_part in stomate DO k= 1, nparts WHERE (PFTpresent(:,j)) resp_maint(:,j) = resp_maint(:,j) + resp_maint_part(:,j,k) ENDWHERE ENDDO ! ! 3.3 This maintenance respiration is taken away from the newly produced ! allocatable biomass. However, we avoid that no allocatable biomass remains. ! If the respiration is larger than a given fraction of the allocatable biomass, ! the rest is taken from the tissues themselves. ! We suppose that respiration is not dependent on leaf age -> ! do not change age structure. ! ! maximum part of allocatable biomass used for respiration bm_tax_max(:) = tax_max * bm_alloc_tot(:,j) DO i = 1, npts IF ( ( bm_alloc_tot(i,j) .GT. zero ) .AND. & ( ( resp_maint(i,j) * dt ) .LT. bm_tax_max(i) ) ) THEN bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - resp_maint(i,j) * dt !Shilong ELSEIF ( resp_maint(i,j) .GT. zero ) THEN ELSEIF ( resp_maint(i,j) .GT. min_stomate ) THEN ! remaining allocatable biomass bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - bm_tax_max(i) ! biomass that remains to be taken away from tissues bm_pump(i) = resp_maint(i,j) * dt - bm_tax_max(i) ! take biomass from tissues biomass(i,j,ileaf) = biomass(i,j,ileaf) - & bm_pump(i) * resp_maint_part(i,j,ileaf) / resp_maint(i,j) biomass(i,j,isapabove) = biomass(i,j,isapabove) - & bm_pump(i) * resp_maint_part(i,j,isapabove) / resp_maint(i,j) biomass(i,j,isapbelow) = biomass(i,j,isapbelow) - & bm_pump(i) * resp_maint_part(i,j,isapbelow) / resp_maint(i,j) biomass(i,j,iroot) = biomass(i,j,iroot) - & bm_pump(i) * resp_maint_part(i,j,iroot) / resp_maint(i,j) biomass(i,j,ifruit) = biomass(i,j,ifruit) - & bm_pump(i) * resp_maint_part(i,j,ifruit) / resp_maint(i,j) biomass(i,j,icarbres) = biomass(i,j,icarbres) - & bm_pump(i) * resp_maint_part(i,j,icarbres) / resp_maint(i,j) ENDIF ENDDO ! Fortran95: WHERE - ELSEWHERE construct ! ! 3.4 dispatch allocatable biomass ! DO k = 1, nparts bm_alloc(:,j,k) = f_alloc(:,j,k) * bm_alloc_tot(:,j) ENDDO ! ! 3.5 growth respiration of a plant part is a given fraction of the ! remaining allocatable biomass. ! resp_growth_part(:,:) = frac_growthresp * bm_alloc(:,j,:) / dt bm_alloc(:,j,:) = ( 1. - frac_growthresp ) * bm_alloc(:,j,:) ! ! 3.6 Total growth respiration of the plant ! VPP killer: ! resp_growth(:,j) = SUM( resp_growth_part(:,:), DIM=2 ) ! resp_growth(:,j) = zero DO k = 1, nparts resp_growth(:,j) = resp_growth(:,j) + resp_growth_part(:,k) ENDDO ENDDO ! ! 4 update the biomass, but save the old leaf mass for later ! "old" leaf mass is leaf mass after maintenance respiration ! lm_old(:,:) = biomass(:,:,ileaf) biomass(:,:,:) = biomass(:,:,:) + bm_alloc(:,:,:) ! ! 5 biomass can become negative in some rare cases, as the GPP can be negative ! (dark respiration). ! In this case, set biomass to some small value. This creation of matter is taken into ! account by decreasing the autotrophic respiration. In this case, maintenance respiration ! can become negative !!! ! DO k = 1, nparts DO j = 2,nvm WHERE ( biomass(:,j,k) .LT. zero ) bm_create(:,j) = min_stomate - biomass(:,j,k) biomass(:,j,k) = biomass(:,j,k) + bm_create(:,j) resp_maint(:,j) = resp_maint(:,j) - bm_create(:,j) / dt ENDWHERE ENDDO ENDDO ! ! 6 Calculate the NPP (gC/(m**2 of ground/day) ! DO j = 2,nvm npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j) ENDDO ! ! 7 leaf age ! ! ! 7.1 Decrease leaf age in youngest class if new leaf biomass is higher than old one. ! DO j = 2,nvm leaf_mass_young(:,j) = leaf_frac(:,j,1) * lm_old(:,j) + bm_alloc(:,j,ileaf) ENDDO DO j = 2,nvm WHERE ( ( bm_alloc(:,j,ileaf) .GT. zero ) .AND. & ( leaf_mass_young(:,j) .GT. zero ) ) leaf_age(:,j,1) = MAX ( zero, & & leaf_age(:,j,1) * & & ( leaf_mass_young(:,j) - bm_alloc(:,j,ileaf) ) / & & leaf_mass_young(:,j) ) ENDWHERE ENDDO ! ! 7.2 new age class fractions (fraction in youngest class increases) ! ! 7.2.1 youngest class: new mass in youngest class divided by total new mass DO j = 2,nvm WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) leaf_frac(:,j,1) = leaf_mass_young(:,j) / biomass(:,j,ileaf) ENDWHERE ENDDO ! 7.2.2 other classes: old mass in leaf age class divided by new mass DO m = 2, nleafages DO j = 2,nvm WHERE ( biomass(:,j,ileaf) .GT. min_stomate ) leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf) ENDWHERE ENDDO ENDDO ! ! 8 Plant age (years) ! ! ! 8.1 Increase age at every time step ! WHERE ( PFTpresent(:,:) ) age(:,:) = age(:,:) + dt/one_year ELSEWHERE age(:,:) = zero ENDWHERE ! ! 8.2 For grasses, decrease age ! if new biomass is higher than old one. ! For trees, age is treated in "establish" if vegetation is dynamic, ! and in turnover routines if it is static (in this case, only take ! into account the age of the heartwood). ! DO j = 2,nvm IF ( .NOT. tree(j) ) THEN ! Only four compartments for grasses ! VPP killer: ! bm_new(:) = SUM( biomass(:,j,:), DIM=2 ) ! bm_add(:) = SUM( bm_alloc(:,j,:), DIM=2 ) bm_new(:) = biomass(:,j,ileaf) + biomass(:,j,isapabove) + & biomass(:,j,iroot) + biomass(:,j,ifruit) bm_add(:) = bm_alloc(:,j,ileaf) + bm_alloc(:,j,isapabove) + & bm_alloc(:,j,iroot) + bm_alloc(:,j,ifruit) WHERE ( ( bm_new(:) .GT. zero ) .AND. ( bm_add(:) .GT. zero ) ) age(:,j) = age(:,j) * ( bm_new(:) - bm_add(:) ) / bm_new(:) ENDWHERE ENDIF ENDDO ! ! 9 history ! CALL histwrite (hist_id_stomate, 'BM_ALLOC_LEAF', itime, & bm_alloc(:,:,ileaf), npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'BM_ALLOC_SAP_AB', itime, & bm_alloc(:,:,isapabove), npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'BM_ALLOC_SAP_BE', itime, & bm_alloc(:,:,isapbelow), npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'BM_ALLOC_ROOT', itime, & bm_alloc(:,:,iroot), npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'BM_ALLOC_FRUIT', itime, & bm_alloc(:,:,ifruit), npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'BM_ALLOC_RES', itime, & bm_alloc(:,:,icarbres), npts*nvm, horipft_index) IF (bavard.GE.4) WRITE(numout,*) 'Leaving npp' END SUBROUTINE npp_calc END MODULE stomate_npp