source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_constraints.f90 @ 257

Last change on this file since 257 was 257, checked in by didier.solyga, 13 years ago

Externalized version merged with the trunk

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