! Initialize density of individuals and crown area to some reasonable value ! if the DGVM is not (yet) activated. ! Prescribe density of individuals and crown area for agricultural PFTs. ! At first call, if the DGVM is not (yet) activated, impose some biomass if zero ! for a prescribed PFT. Initialize leaf age classes. ! At first call, if the DGVM is not (yet) activated, declare PFT present if its ! prescribed vegetation cover is above 0 ! !< $HeadURL$ !< $Date$ !< $Author$ !< $Revision$ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_prescribe ! modules used: USE ioipsl USE stomate_data USE pft_parameters USE constantes IMPLICIT NONE ! private & public routines PRIVATE PUBLIC prescribe,prescribe_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE prescribe_clear firstcall=.TRUE. END SUBROUTINE prescribe_clear SUBROUTINE prescribe (npts, & veget_max, PFTpresent, everywhere, when_growthinit, & biomass, leaf_frac, ind, cn_ind) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! 0.2 modified fields ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max ! PFT present 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 ! biomass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass ! fraction of leaves in leaf age class REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac ! density of individuals (1/(m**2 of ground)) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ind ! crown area of individuals (m**2) REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cn_ind ! 0.3 output ! 0.4 local ! stem diameter (m) REAL(r_std), DIMENSION(npts) :: dia ! woodmass (gC/(m**2 of ground)) REAL(r_std), DIMENSION(npts) :: woodmass ! woodmass of an individual (gC) REAL(r_std), DIMENSION(npts) :: woodmass_ind ! index INTEGER(i_std) :: i,j ! ========================================================================= DO j = 2,nvm ! only when the DGVM is not activated or agricultural PFT. IF ( ( .NOT. control%ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) ) THEN ! ! 1 crown area ! cn_ind(:,j) = zero IF ( tree(j) ) THEN ! ! 1.1 trees ! dia(:) = zero DO i = 1, npts IF ( veget_max(i,j) .GT. zero ) THEN ! 1.1.1 calculate total wood mass woodmass(i) = (biomass(i,j,isapabove) + biomass(i,j,isapbelow) + & biomass(i,j,iheartabove) + biomass(i,j,iheartbelow)) * veget_max(i,j) IF ( woodmass(i) .GT. min_stomate ) THEN ! 1.1.2 calculate critical density of individuals ind(i,j) = woodmass(i) / & ( pipe_density*pi/4.*pipe_tune2 * maxdia(j)**(2.+pipe_tune3) ) ! 1.1.3 individual biomass corresponding to this critical density of individuals woodmass_ind(i) = woodmass(i) / ind(i,j) ! 1.1.4 stem diameter dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** & ( un / ( 2. + pipe_tune3 ) ) ! 1.1.5 crown area, provisional cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff ! 1.1.6 do we have to recalculate the crown area? IF ( cn_ind(i,j) * ind(i,j) .GT. 1.002* veget_max(i,j) ) THEN ind(i,j) = veget_max(i,j) / cn_ind(i,j) ELSE ind(i,j) = ( veget_max(i,j) / & & ( pipe_tune1 * (woodmass(i)/(pipe_density*pi/4.*pipe_tune2)) & & **(pipe_tune_exp_coeff/(2.+pipe_tune3)) ) ) & & ** (1./(1.-(pipe_tune_exp_coeff/(2.+pipe_tune3)))) woodmass_ind(i) = woodmass(i) / ind(i,j) dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** & ( un / ( 2. + pipe_tune3 ) ) ! final crown area cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff ENDIF ELSE ! woodmass = 0 => impose some value dia(:) = maxdia(j) cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff ENDIF ENDIF ! veget_max .GT. 0. ENDDO ! loop over grid points ELSE ! ! 1.2 grasses: always 1m**2 ! WHERE ( veget_max(:,j) .GT. zero ) cn_ind(:,j) = un ENDWHERE ENDIF ! tree/grass? ! ! 2 density of individuals ! WHERE ( veget_max(:,j) .GT. zero ) ind(:,j) = veget_max(:,j) / cn_ind(:,j) ELSEWHERE ind(:,j) = zero ENDWHERE ENDIF ! not natural or DGVM not activated? ENDDO ! loop over PFTs ! ! 4 first call ! IF ( firstcall ) THEN WRITE(numout,*) 'prescribe:' ! impose some biomass if zero and PFT prescribed WRITE(numout,*) ' > Imposing initial biomass for prescribed trees, '// & 'initial reserve mass for prescribed grasses.' WRITE(numout,*) ' > Declaring prescribed PFTs present.' DO j = 2,nvm DO i = 1, npts ! is vegetation static or PFT agricultural? IF ( ( .NOT. control%ok_dgvm ) .OR. & ( ( .NOT. natural(j) ) .AND. ( veget_max(i,j) .GT. min_stomate ) ) ) THEN ! ! 4.1 trees ! IF ( tree(j) .AND. & ( veget_max(i,j) .GT. min_stomate ) .AND. & ( SUM( biomass(i,j,:) ) .LE. min_stomate ) ) THEN IF (veget_max(i,j) .GT. min_stomate) THEN biomass(i,j,:) = (bm_sapl_rescale * bm_sapl(j,:) * ind(i,j)) / veget_max(i,j) ELSE biomass(i,j,:) = zero ENDIF ! set leaf age classes leaf_frac(i,j,:) = zero leaf_frac(i,j,1) = un ! set time since last beginning of growing season when_growthinit(i,j) = large_value ! seasonal trees: no leaves at beginning IF ( pheno_model(j) .NE. 'none' ) THEN biomass(i,j,ileaf) = zero leaf_frac(i,j,1) = zero ENDIF ENDIF ! ! 4.2 grasses ! IF ( ( .NOT. tree(j) ) .AND. & ( veget_max(i,j) .GT. min_stomate ) .AND. & ( SUM( biomass(i,j,:) ) .LE. min_stomate ) ) THEN biomass(i,j,icarbres) = bm_sapl(j,icarbres) * ind(i,j) / veget_max(i,j) ! set leaf age classes leaf_frac(i,j,:) = zero leaf_frac(i,j,1) = un ! set time since last beginning of growing season when_growthinit(i,j) = large_value ENDIF ! ! 4.3 declare PFT present everywhere in that grid box ! IF ( veget_max(i,j) .GT. min_stomate ) THEN PFTpresent(i,j) = .TRUE. everywhere(i,j) = un ENDIF ENDIF ! not control%ok_dgvm or agricultural ENDDO ENDDO firstcall = .FALSE. ENDIF END SUBROUTINE prescribe END MODULE stomate_prescribe