source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/lpj_constraints.f90 @ 880

! 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