source: branches/publications/ORCHIDEE-LEAK-r5919/src_stomate/lpj_constraints.f90 @ 5925

Last change on this file since 5925 was 2944, checked in by josefine.ghattas, 9 years ago

Ticket #182

Cleaning after commit update of DGVM.

  • Calculated veget_max_tree and nbtree to make independent of the number of pfts.
  • Added new parameters used instead of numbers in the code.
  • Added more comments.
  • Property svn:keywords set to HeadURL Date Author Revision
File size: 10.1 KB
Line 
1! =================================================================================================================================
2! MODULE       : lpj_constraints
3!
4! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
5!
6! LICENCE      : IPSL (2006)
7!              This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF       Groups the subroutines that: (1) initialize all variables in
10!! lpj_constraints and (2) check the temperature threshold to decide for each PFT
11!! if it can adapt to and regenerate under prevailing climate conditions**1
12!!
13!!\n RECENT CHANGE(S) : None
14!!
15!! REFERENCE(S) :
16!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
17!!   plant geography and terrestrial carbon cycling in the LPJ dynamic
18!!   global vegetation model, Global Change Biology, 9, 161-185.\n
19!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
20!!   dynamics in the modelling of terrestrial ecosystems: comparing two
21!!   contrasting approaches within European climate space,
22!!   Global Ecology and Biogeography, 10, 621-637.\n
23!!
24!! SVN          :
25!! $HeadURL$
26!! $Date$
27!! $Revision$
28!! \n
29!_ ================================================================================================================================
30
31MODULE lpj_constraints
32
33  ! modules used:
34  USE xios_orchidee
35  USE ioipsl_para
36  USE stomate_data
37  USE constantes
38  USE pft_parameters
39
40  IMPLICIT NONE
41
42  ! private & public routines
43
44  PRIVATE
45  PUBLIC constraints,constraints_clear
46
47  REAL(r_std), PARAMETER          :: grow_limit = 7+ZeroCelsius          !! Growing-season temperature limit to tree extension (K)
48  LOGICAL, SAVE                   :: firstcall_constraints = .TRUE.      !! first call
49!$OMP THREADPRIVATE(firstcall_constraints)
50
51CONTAINS
52
53!! ================================================================================================================================
54!! SUBROUTINE   : constraints_clear
55!!
56!>\BRIEF        Set the flag ::firstcall_constraints to .TRUE. and as such activate section
57!!              1.1 of the subroutine constraints (see subroutine constraints).
58!!
59!_ ================================================================================================================================
60
61  SUBROUTINE constraints_clear
62    firstcall_constraints = .TRUE. 
63  END SUBROUTINE constraints_clear
64
65
66!! ================================================================================================================================
67!! SUBROUTINE   : constraints
68!!
69!>\BRIEF        Determine whether each PFT can adapt to and regenerate under the prevailing climate
70!! conditions. Climate conditions are characterised by different threshold values for air temperature.
71!!
72!! DESCRIPTION : PFTs are adapted to the climate conditions if the daily air temperature does not drop below
73!! the treshold values ::tcm_crit. Some PFT's do not have a ::tcm_crit treshold. Seasonal trees die if leafage
74!! does not show a clear seasonality. (i.e. if the start of the growing season is never detected)
75!!
76!! If the monthly temperature is below ::tcm_crit i.e. the critical temperature of the coldest month, the
77!! PFT will be able to regenerate. If minimum temperatures do not drop below ::tcm_crit, its regenerative
78!! capacity decreases with time. Hence, plants that need vernalization die after a few years if they don't
79!! vernalize (even if they would not loose their leaves).
80!!
81!! The treshold values ::t_min_crit, the critical temperature of the coldest month is defined in
82!! stomate_constants.f90'. However, ::regenerate_min, the critical temperature to support regeneration is
83!! calculated in this routine from parameters of which none depenent on the PFT. The value for
84!! ::large_value is defined as 1.E33 in stomata_constraints
85!!
86!! RECENT CHANGE(S) : None
87!!
88!! MAIN OUTPUT VARIABLE(S) : ::adapted (0-1, unitless) and ::regenerate (0-1, unitless)
89!!
90!! REFERENCE(S) : None
91!!
92!! FLOWCHART :
93!! \latexonly
94!!     \includegraphics[scale=0.3]{lpj_constraints_flowchart.png}
95!! \endlatexonly
96!! \n
97!_ ================================================================================================================================
98 
99    SUBROUTINE constraints (npts, dt, &
100       t2m_month, t2m_min_daily, when_growthinit, Tseason, &
101       adapted, regenerate)
102   
103    !! 0. Variable and parameter declaration
104   
105    !! 0.1 Input variable
106
107    INTEGER(i_std), INTENT(in)                      :: npts            !! Domain size (unitless)
108    REAL(r_std), INTENT(in)                         :: dt              !! Time step   (days)
109    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_month       !! "Monthly" 2-meter temperature by defualt
110                                                                       !! monthly spans 20 days a (K)
111    REAL(r_std), DIMENSION(npts), INTENT(in)        :: Tseason         !! "seasonal" 2-meter temperature (K)
112    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_min_daily   !! Daily minimum 2-meter temperature (K)
113    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: when_growthinit !! Days since beginning of growing season (days)
114
115    !! 0.2 Output variables
116
117    !! 0.3 Modified variables
118 
119    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: adapted         !! Winter too cold? (0 to 1, unitless)
120    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate      !! Winter sufficiently cold? (0 to 1, unitless)
121
122    !! 0.4 Local variables
123
124    REAL(r_std)                                     :: tau_adapt       !! Memory length for adaption (days)
125    REAL(r_std)                                     :: tau_regenerate  !! Memory length for regeneration (days)
126    REAL(r_std)                                     :: regenerate_min  !! Critical value of "regenerate" below which plant
127                                                                       !! dies (unitless)
128    INTEGER(i_std)                                  :: j               !! Index
129!_ ================================================================================================================================
130
131    IF (printlev>=3) WRITE(numout,*) 'Entering constraints' ! diagnostic level in implimentation
132
133  !! 1. Initializations
134
135    tau_adapt = one_year
136    tau_regenerate = one_year
137
138    !! 1.1 Print parameter settings
139    IF ( firstcall_constraints ) THEN
140
141       WRITE(numout,*) 'constraints:'
142       
143       WRITE(numout,*) '   > Memory length for adaption (d): ',tau_adapt
144       WRITE(numout,*) '   > Memory length for regeneration (d): ',tau_regenerate
145       WRITE(numout,*) '   > Longest sustainable time without vernalization (y):', too_long
146       WRITE(numout,*) '   > For trees, longest sustainable time without growth init (y):', too_long
147       
148       firstcall_constraints = .FALSE.
149       
150    ENDIF
151
152    !! 1.2 Calculate critical value for "regenerate"
153    !      Critical value for "regenerate", below this value, the last vernalization
154    !      happened too far in the past, The PFT is can not regenerate under the
155    !      prevailing climate conditions.
156    regenerate_min = exp ( - too_long * one_year / tau_regenerate )
157
158  !! 2. Calculate ::adapted and ::regenerate
159
160    DO j = 2,nvm ! Loop over # PFTs
161
162       !! 2.1 PFT mask for natural or agriculture vegetations
163       IF ( natural(j) .OR. agriculture ) THEN
164
165          !! 2.1.1 Climate criteria
166          !! There is no critical temperature for the PFT
167          !  Frost restistant PFT do not have a critical temperature for growth
168          IF ( tmin_crit(j) .EQ. undef ) THEN
169             adapted(:,j) = un 
170          ENDIF
171
172          !! 2.1.2 Seasonal trees die if leafage does not show a clear seasonality.
173          !        Seasonal trees die if leafage does not show a clear seasonality
174          !        (i.e. if the start of the growing season is never detected).
175          IF ( is_tree(j) .AND. ( pheno_model(j) .NE. 'none' ) ) THEN
176
177             WHERE ( when_growthinit(:,j) .GT. too_long*one_year .AND. when_growthinit(:,j).LT. large_value)
178                adapted(:,j) = zero
179             ENDWHERE
180
181          ENDIF
182
183          ! "seasonal" temperature Tseason must exceed 7 degree (grow_limit) for trees to be declared adapted.
184          IF ( is_tree(j) ) THEN
185             WHERE ( Tseason(:) .LT. grow_limit )
186                adapted(:,j)=zero
187             ENDWHERE
188          ENDIF
189
190          adapted(:,j) = un - ( un - adapted(:,j) ) * (tau_adapt- dt)/tau_adapt 
191
192          !! 2.1.3 Test if PFT is regenerative
193
194          !! 2.1.3.1 Check PFT vernalization.
195          !          If sufficiently cold, PFT will be able to regenerate for some time.
196          !          Several PFTs (ex: evergreen) don't need vernalization
197          IF ( tcm_crit(j) .EQ. undef ) THEN
198
199             regenerate(:,j) = un
200
201          !! 2.1.3.2 PFT needs vernalization
202          ELSE
203
204             WHERE ( t2m_month(:) .LE. tcm_crit(j) )
205                regenerate(:,j) = un
206             ENDWHERE
207
208             ! Limited memory: after some time, the winter is forgotten and the PFT can no longer
209             ! produce seeds, hence, with time ::regenerate approaches 0
210             regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate
211
212          ENDIF
213
214          !! 2.1.4 Plants that need vernalization die
215          !        Plants that need vernalization die after a few years if they don't
216          !        vernalize (even if they would not loose their leaves).
217          WHERE ( regenerate(:,j) .LE. regenerate_min )
218             adapted(:,j) = zero
219          ENDWHERE
220
221       !! 2.1 PFT except natual and agriculture vegetation
222       !      Should be developed if needed
223       ELSE
224
225          adapted(:,j) = zero
226
227          regenerate(:,j) = zero
228
229       ENDIF ! PFT of natural or agriculture
230
231    ENDDO ! Loop over # PFTs
232
233  !! 3. Write history files
234    CALL xios_orchidee_send_field("ADAPTATION",adapted)
235    CALL xios_orchidee_send_field("REGENERATION",regenerate)
236
237    CALL histwrite_p (hist_id_stomate, 'ADAPTATION', itime, &
238         adapted, npts*nvm, horipft_index)
239    CALL histwrite_p (hist_id_stomate, 'REGENERATION', itime, &
240         regenerate, npts*nvm, horipft_index)
241
242    IF (printlev>=4) WRITE(numout,*) 'Leaving constraints'
243
244  END SUBROUTINE constraints
245
246END MODULE lpj_constraints
Note: See TracBrowser for help on using the repository browser.