! throw out respectively introduce some PFTS ! !< $HeadURL$ !< $Date$ !< $Author$ !< $Revision$ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE lpj_pftinout ! modules used: USE ioipsl USE stomate_data USE pft_parameters USE constantes IMPLICIT NONE ! private & public routines PRIVATE PUBLIC pftinout,pftinout_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE pftinout_clear firstcall = .TRUE. END SUBROUTINE pftinout_clear SUBROUTINE pftinout (npts, dt, adapted, regenerate, & neighbours, veget, veget_max, & biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, & PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, & co2_to_bm, & avail_tree, avail_grass) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! Time step (days) REAL(r_std), INTENT(in) :: dt ! Winter not too cold REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: adapted ! Winter sufficiently cold REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: regenerate ! indices of the 8 neighbours of each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) INTEGER(i_std), DIMENSION(npts,8), INTENT(in) :: neighbours ! fractional coverage on ground, taking into ! account LAI (=grid-scale fpc) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max ! 0.2 modified fields ! biomass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass ! density of individuals 1/m**2 REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind ! crownarea of individuals m**2 REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind ! mean age (years) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: age ! fraction of leaves in leaf age class REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac ! "long term" net primary productivity (gC/(m**2 of ground)/year) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm ! last year's maximum leaf mass, for each PFT (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax ! is the plant senescent? (only for deciduous trees - carbohydrate reserve) ! set to .FALSE. if PFT is introduced or killed LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: senescence ! PFT exists LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: PFTpresent ! is the PFT everywhere in the grid box or very localized (after its introduction) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: everywhere ! how many days ago was the beginning of the growing season REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit ! in order for this PFT to be introduced, does it have to be present in an ! adjacent grid box? LOGICAL, DIMENSION(npts,nvm), INTENT(inout) :: need_adjacent ! How much time ago was the PFT eliminated for the last time (y) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: RIP_time ! biomass uptaken (gC/(m**2 of total ground)/day) !NV passage 2D REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: co2_to_bm ! 0.3 output ! space availability for trees REAL(r_std), DIMENSION(npts), INTENT(out) :: avail_tree ! space availability for grasses REAL(r_std), DIMENSION(npts), INTENT(out) :: avail_grass ! 0.4 local ! availability REAL(r_std), DIMENSION(npts) :: avail ! indices INTEGER(i_std) :: i,j,m ! total woody vegetation cover REAL(r_std), DIMENSION(npts) :: sumfrac_wood ! number of adjacent grid cells where PFT is ubiquitious INTEGER(i_std), DIMENSION(npts) :: n_present ! we can introduce this PFT LOGICAL, DIMENSION(npts) :: can_introduce ! no real need for dimension(ntps) except for vectorisation REAL(r_std), DIMENSION(npts) :: fracnat ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering pftinout' ! ! 1 Messages ! IF ( firstcall ) THEN WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail firstcall = .FALSE. ENDIF ! ! 2 Space availability ! ! 2.1 Only natural part of the grid cell ! !SZ bug correction MERGE: need to subtract agricultural area! ! fraction of agricultural surface fracnat(:) = un do j = 2,nvm IF ( .NOT. natural(j) ) THEN fracnat(:) = fracnat(:) - veget_max(:,j) ENDIF ENDDO ! ! 2.2 total woody fpc on grid ! sumfrac_wood(:) = zero DO j = 2,nvm !SZ problem here: agriculture, not convinced that this representation of LPJ is correct !if agriculture is present, ind must be recalculated to correspond to the natural density... ! since ind is per grid cell, can be achived by discounting for agricultura fraction IF ( natural(j).AND.tree(j) ) THEN WHERE(fracnat(:).GT.min_stomate) sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ) !lai changed to lm_last ENDWHERE ENDIF ENDDO avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail ) avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail ) ! ! 3 Time since last elimination (y) ! RIP_time = RIP_time + dt / one_year ! ! 4 Agicultural PFTs: present if they are prescribed ! DO j = 2,nvm IF ( .NOT. natural(j) ) THEN IF (bavard.GE.4) WRITE(numout,*) 'pftinout: Agricultural PFTs' IF ( tree(j) ) THEN ! ! 4.1 don't treat agricultural trees for the moment ! WRITE(numout,*) 'pftinout: Agricultural trees not treated. We stop.' STOP ELSE ! ! 4.2 grasses ! DO i = 1, npts IF ( ( veget_max(i,j) .GT. zero ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN ! prescribed, but not yet there. ind(i,j) = veget_max(i,j) biomass(i,j,:) = bm_sapl(j,:) * ind(i,j) /veget_max(i,j) ! TL !NV passge 2D co2_to_bm(i,j) = co2_to_bm(i,j) +SUM( biomass(i,j,:) ) / dt PFTpresent(i,j) = .TRUE. everywhere(i,j) = un senescence(i,j) = .FALSE. age(i,j) = zero ENDIF ! prescribed, but PFT not yet present ENDDO ! loop over grid points ENDIF ENDIF ! not natural ENDDO ! loop over PFTs ! ! 5 Eliminate PFTs ! DO j = 2,nvm ! only for natural PFTs IF ( natural(j) ) THEN WHERE ( PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) ) ! PFT there, but not adapted any more (ex: winter too cold): kill ! set number of individuals to zero - rest will be done in lpj_kill ind(:,j) = zero ENDWHERE ENDIF ! natural ENDDO ! loop over PFTs ! ! 6 Introduce PFTs ! DO j = 2,nvm IF ( natural(j) ) THEN ! space availability for this PFT IF ( tree(j) ) THEN avail(:) = avail_tree(:) ELSE avail(:) = avail_grass(:) ENDIF ! ! 6.1 Check if PFT not present but (adapted and regenerative) ! can_introduce(:) = .FALSE. DO i = 1, npts IF ( .NOT. PFTpresent(i,j) .AND. & ( adapted(i,j) .GT. adapted_crit ) .AND. & ( regenerate(i,j) .GT. regenerate_crit ) ) THEN ! climate allows introduction IF ( need_adjacent(i,j) ) THEN ! 6.1.1 climate allows introduction, but we need to look at the neighbours ! If the PFT has totally invaded at least one adjacent ! grid cell, it can be introduced. ! count number of totally invaded neighbours ! no loop so that it can vectorize n_present(i) = 0 IF ( neighbours(i,1) .GT. 0 ) THEN IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN n_present(i) = n_present(i)+1 ENDIF ENDIF IF ( neighbours(i,3) .GT. 0 ) THEN IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN n_present(i) = n_present(i)+1 ENDIF ENDIF IF ( neighbours(i,5) .GT. 0 ) THEN IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN n_present(i) = n_present(i)+1 ENDIF ENDIF IF ( neighbours(i,7) .GT. 0 ) THEN IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN n_present(i) = n_present(i)+1 ENDIF ENDIF IF ( n_present(i) .GT. 0 ) THEN ! PFT is ubiquitious in at least one adjacent grid box can_introduce(i) = .TRUE. ENDIF ELSE ! 6.1.2 we don't have to look at neighbours can_introduce(i) = .TRUE. ENDIF ! do we have to look at the neighbours? ENDIF ! we'd like to introduce the PFT ENDDO ! loop over grid points ! ! 6.2 additionally test whether the PFT has been eliminated lately, i.e. ! less than 1.25 years ago. Do not take full years as success of ! introduction might depend on season. WHERE ( RIP_time(:,j) .LT. RIP_time_min ) ! PFT was eliminated lately - cannot reintroduce can_introduce(:) = .FALSE. ENDWHERE ! ! 6.3 Introduce that PFT where possible ! "can_introduce" means that it either exists in neighbouring grid boxes ! or that we do not look at neighbours, that it has not been eliminated ! lately, and, of course, that the climate is good for that PFT. ! WHERE ( can_introduce(:) ) PFTpresent(:,j) = .TRUE. senescence(:,j) = .FALSE. ! introduce at least a few saplings, even if canopy is closed ind(:,j) = ind_0 * (dt/one_year) * avail(:) WHERE(veget_max(:,j) .GT. zero) biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j) /veget_max(:,j) biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j) /veget_max(:,j) biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)/veget_max(:,j) biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)/veget_max(:,j) biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)/veget_max(:,j) biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)/veget_max(:,j) biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)/veget_max(:,j) biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)/veget_max(:,j) ELSEWHERE biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j) biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j) biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j) biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j) biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j) biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j) biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j) biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j) END WHERE !NV passge 2D co2_to_bm(:,j) = & co2_to_bm(:,j) / dt * & ( biomass(:,j,ileaf) + biomass(:,j,isapabove) + & biomass(:,j,isapbelow) + biomass(:,j,iheartabove) + & biomass(:,j,iheartbelow) + biomass(:,j,iroot) + & biomass(:,j,ifruit) + biomass(:,j,icarbres) ) when_growthinit(:,j) = large_value age(:,j) = zero ! all leaves are young leaf_frac(:,j,1) = un ! non-zero "long term" npp and last year's leaf mass for saplings - ! so they won't be killed off by gap or kill npp_longterm(:,j) = npp_longterm_init lm_lastyearmax(:,j) = bm_sapl(j,ileaf) * ind(:,j) ENDWHERE ! we can introduce the PFT ! ! 6.4 expansion of the PFT within the grid box (not to be confused with areal ! coverage) ! IF ( treat_expansion ) THEN WHERE ( can_introduce(:) ) ! low value at the beginning everywhere(:,j) = everywhere_init ENDWHERE ELSE ! expansion is not treated WHERE ( can_introduce(:) ) everywhere(:,j) = un ENDWHERE ENDIF ! treat expansion ENDIF ! only natural PFTs ENDDO ! loop over PFTs ! ! 7 If a PFT has been present once in a grid box, we suppose that it will survive ! in isolated places (e.g., an oasis) within that grid box, even if it gets ! officially eliminated from it later. That means that if climate becomes favorable ! again, it will not need to get seeds from adjacent grid cells. ! WHERE ( PFTpresent ) need_adjacent = .FALSE. ENDWHERE IF (bavard.GE.4) WRITE(numout,*) 'Leaving pftinout' END SUBROUTINE pftinout END MODULE lpj_pftinout