source: tags/ORCHIDEE/src_stomate/lpj_constraints.f90 @ 6

Last change on this file since 6 was 6, checked in by orchidee, 14 years ago

import first tag equivalent to CVS orchidee_1_9_5 + OOL_1_9_5

File size: 5.5 KB
Line 
1! determine whether a PFT is adapted and can regenerate
2!
3! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_constraints.f90,v 1.8 2009/01/06 15:01:25 ssipsl Exp $
4! IPSL (2006)
5!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
6!
7MODULE lpj_constraints
8
9  ! modules used:
10
11  USE ioipsl
12  USE stomate_constants
13  USE constantes_veg
14
15  IMPLICIT NONE
16
17  ! private & public routines
18
19  PRIVATE
20  PUBLIC constraints,constraints_clear
21
22  ! first call
23  LOGICAL, SAVE                                    :: firstcall = .TRUE.
24CONTAINS
25
26
27  SUBROUTINE constraints_clear
28    firstcall = .TRUE. 
29  END SUBROUTINE constraints_clear
30
31  SUBROUTINE constraints (npts, dt, &
32       t2m_month, t2m_min_daily, when_growthinit, &
33       adapted, regenerate)
34
35    !
36    ! 0 declarations
37    !
38
39    ! 0.1 input
40
41    ! Domain size
42    INTEGER(i_std), INTENT(in)                              :: npts
43    ! time step (in days)
44    REAL(r_std), INTENT(in)                           :: dt
45    ! "monthly" 2-meter temperature (K)
46    REAL(r_std), DIMENSION(npts), INTENT(in)          :: t2m_month
47    ! Daily minimum 2-meter temperature (K)
48    REAL(r_std), DIMENSION(npts), INTENT(in)          :: t2m_min_daily
49    ! how many days ago was the beginning of the growing season
50    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)     :: when_growthinit
51
52    ! 0.2 output fields
53
54    ! Winter too cold? between 0 and 1
55    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: adapted
56    ! Winter sufficiently cold? between 0 and 1
57    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)  :: regenerate
58
59    ! 0.3 local
60
61    ! Memory length for adaption (d)
62    REAL(r_std)                                       :: tau_adapt
63    ! Memory length for regeneration (d)
64    REAL(r_std)                                       :: tau_regenerate 
65    ! longest sustainable time without regeneration (vernalization)
66    REAL(r_std), PARAMETER                            :: too_long = 5.
67    ! critical value of "regenerate" below which plant dies
68    REAL(r_std)                                       :: regenerate_min
69    ! index
70    INTEGER(i_std)                                    :: j
71
72    ! =========================================================================
73
74    IF (bavard.GE.3) WRITE(numout,*) 'Entering constraints'
75
76    !
77    ! 1 Initializations
78    !
79    tau_adapt = one_year
80    tau_regenerate = one_year
81    !
82    ! 1.1 Messages
83    !
84
85    IF ( firstcall ) THEN
86
87       WRITE(numout,*) 'constraints:'
88
89       WRITE(numout,*) '   > Memory length for adaption (d): ',tau_adapt
90       WRITE(numout,*) '   > Memory length for regeneration (d): ',tau_regenerate
91       WRITE(numout,*) '   > Longest sustainable time without vernalization (y):', too_long
92       WRITE(numout,*) '   > For trees, longest sustainable time without growth init (y):', &
93            too_long
94
95       firstcall = .FALSE.
96
97    ENDIF
98
99    !
100    ! 1.2 critical value for "regenerate": below this value, the last vernalization
101    !     belong to a too distant past. PFT is then not adapted.
102    !
103
104    regenerate_min = exp ( - too_long * one_year / tau_regenerate )
105
106    !
107    ! 2 Loop over all PFTs
108    !
109
110    DO j = 2,nvm
111
112       IF ( natural(j) .OR. agriculture ) THEN
113
114          !
115          ! 2.1 climate criteria
116          !
117
118          ! 2.1.1 Test if PFT is adapted: check daily temperature.
119          !       If too cold, PFT is not adapted.
120
121          IF ( tmin_crit(j) .EQ. undef ) THEN
122
123             ! 2.1.1.1 some PFTs always survive.
124
125             adapted(:,j) = 1.
126
127          ELSE
128
129             ! 2.1.1.2 frost-sensitive PFTs
130
131             WHERE ( t2m_min_daily(:) .LT. tmin_crit(j) )
132                adapted(:,j) = 0.
133             ENDWHERE
134
135             ! limited memory: after some time, the cold shock is forgotten.
136             !  ( adapted will approach 1)
137
138             adapted(:,j) = 1. - ( 1. - adapted(:,j) ) * (tau_adapt- dt)/tau_adapt
139
140          ENDIF
141
142          !
143          ! 2.1.2 seasonal trees die if leafage does not show a clear seasonality.
144          !       (i.e. if the start of the growing season is never detected).
145          !
146
147          IF ( tree(j) .AND. ( pheno_crit%pheno_model(j) .NE. 'none' ) ) THEN
148
149             WHERE ( when_growthinit(:,j) .GT. too_long*one_year )
150                adapted(:,j) = 0.
151             ENDWHERE
152
153          ENDIF
154
155          ! 2.1.3 Test if PFT is regenerative
156          !       check monthly temperature. If sufficiently cold, PFT will be able to
157          !       regenerate for some time.
158
159          IF ( tcm_crit(j) .EQ. undef ) THEN
160
161             ! 2.1.3.1 several PFTs (ex: evergreen) don't need vernalization
162
163             regenerate(:,j) = 1.
164
165          ELSE
166
167             ! 2.1.3.2 PFT needs vernaliztion
168
169             WHERE ( t2m_month(:) .LE. tcm_crit(j) )
170                regenerate(:,j) = 1.
171             ENDWHERE
172
173             ! limited memory: after some time, the winter is forgotten.
174             !  (regenerate will approach 0)
175
176             regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate
177
178          ENDIF
179
180          ! 2.1.4 Plants that need vernalization die after a few years if they don't
181          !       vernalize (even if they would not loose their leaves).
182
183          WHERE ( regenerate(:,j) .LE. regenerate_min )
184             adapted(:,j) = 0.
185          ENDWHERE
186
187       ELSE
188
189          !
190          ! 2.2 PFT is not natural and agriculture is not allowed -> remove
191          !
192
193          adapted(:,j) = 0.
194
195          regenerate(:,j) = 0.
196
197       ENDIF
198
199    ENDDO
200
201    IF (bavard.GE.4) WRITE(numout,*) 'Leaving constraints'
202
203  END SUBROUTINE constraints
204
205END MODULE lpj_constraints
Note: See TracBrowser for help on using the repository browser.