! determine whether a PFT is adapted and can regenerate ! !< $HeadURL$ !< $Date$ !< $Author$ !< $Revision$ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE lpj_constraints ! modules used: USE ioipsl USE stomate_data USE constantes USE pft_parameters IMPLICIT NONE ! private & public routines PRIVATE PUBLIC constraints,constraints_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE constraints_clear firstcall = .TRUE. END SUBROUTINE constraints_clear SUBROUTINE constraints (npts, dt, & t2m_month, t2m_min_daily, when_growthinit, & adapted, regenerate) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! time step (in days) REAL(r_std), INTENT(in) :: dt ! "monthly" 2-meter temperature (K) REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_month ! Daily minimum 2-meter temperature (K) REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_min_daily ! how many days ago was the beginning of the growing season REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit ! 0.2 output fields ! Winter too cold? between 0 and 1 REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: adapted ! Winter sufficiently cold? between 0 and 1 REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate ! 0.3 local ! Memory length for adaption (d) REAL(r_std) :: tau_adapt ! Memory length for regeneration (d) REAL(r_std) :: tau_regenerate ! critical value of "regenerate" below which plant dies REAL(r_std) :: regenerate_min ! index INTEGER(i_std) :: j ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering constraints' ! ! 1 Initializations ! tau_adapt = one_year tau_regenerate = one_year ! ! 1.1 Messages ! IF ( firstcall ) THEN WRITE(numout,*) 'constraints:' WRITE(numout,*) ' > Memory length for adaption (d): ',tau_adapt WRITE(numout,*) ' > Memory length for regeneration (d): ',tau_regenerate WRITE(numout,*) ' > Longest sustainable time without vernalization (y):', too_long WRITE(numout,*) ' > For trees, longest sustainable time without growth init (y):', & too_long firstcall = .FALSE. ENDIF ! ! 1.2 critical value for "regenerate": below this value, the last vernalization ! belong to a too distant past. PFT is then not adapted. ! regenerate_min = exp ( - too_long * one_year / tau_regenerate ) ! ! 2 Loop over all PFTs ! DO j = 2,nvm IF ( natural(j) .OR. agriculture ) THEN ! ! 2.1 climate criteria ! ! 2.1.1 Test if PFT is adapted: check daily temperature. ! If too cold, PFT is not adapted. IF ( tmin_crit(j) .EQ. undef ) THEN ! 2.1.1.1 some PFTs always survive. adapted(:,j) = un ELSE ! 2.1.1.2 frost-sensitive PFTs WHERE ( t2m_min_daily(:) .LT. tmin_crit(j) ) adapted(:,j) = zero ENDWHERE ! limited memory: after some time, the cold shock is forgotten. ! ( adapted will approach 1) adapted(:,j) = un - ( un - adapted(:,j) ) * (tau_adapt- dt)/tau_adapt ENDIF ! ! 2.1.2 seasonal trees die if leafage does not show a clear seasonality. ! (i.e. if the start of the growing season is never detected). ! IF ( tree(j) .AND. ( pheno_model(j) .NE. 'none' ) ) THEN WHERE ( when_growthinit(:,j) .GT. too_long*one_year .AND. when_growthinit(:,j).LT. large_value) adapted(:,j) = zero ENDWHERE ENDIF ! 2.1.3 Test if PFT is regenerative ! check monthly temperature. If sufficiently cold, PFT will be able to ! regenerate for some time. IF ( tcm_crit(j) .EQ. undef ) THEN ! 2.1.3.1 several PFTs (ex: evergreen) don't need vernalization regenerate(:,j) = un ELSE ! 2.1.3.2 PFT needs vernaliztion WHERE ( t2m_month(:) .LE. tcm_crit(j) ) regenerate(:,j) = un ENDWHERE ! limited memory: after some time, the winter is forgotten. ! (regenerate will approach 0) regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate ENDIF ! 2.1.4 Plants that need vernalization die after a few years if they don't ! vernalize (even if they would not loose their leaves). WHERE ( regenerate(:,j) .LE. regenerate_min ) adapted(:,j) = zero ENDWHERE ELSE ! ! 2.2 PFT is not natural and agriculture is not allowed -> remove ! adapted(:,j) = zero regenerate(:,j) = zero ENDIF ENDDO CALL histwrite (hist_id_stomate, 'ADAPTATION', itime, & adapted, npts*nvm, horipft_index) CALL histwrite (hist_id_stomate, 'REGENERATION', itime, & regenerate, npts*nvm, horipft_index) IF (bavard.GE.4) WRITE(numout,*) 'Leaving constraints' END SUBROUTINE constraints END MODULE lpj_constraints