source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_stomate/stomate_vmax.f90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
  1. Zhang publication on coupling factor
File size: 12.4 KB
Line 
1! =================================================================================================================================
2! MODULE        : stomate_vmax
3!
4! CONTACT       : orchidee-help _at_ listes.ipsl.fr
5!
6! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
7!
8!>\BRIEF        calculates the leaf efficiency.
9!!     
10!!\n DESCRIPTION: None
11!!
12!! RECENT CHANGE(S): None
13!!
14!! SVN          :
15!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_stomate/stomate_vmax.f90 $
16!! $Date: 2017-10-18 11:15:06 +0200 (Wed, 18 Oct 2017) $
17!! $Revision: 4693 $
18!! \n
19!_ =================================================================================================================================
20
21MODULE stomate_vmax
22
23  ! modules used:
24
25  USE ioipsl_para
26  USE stomate_data
27  USE constantes
28  USE pft_parameters
29
30  IMPLICIT NONE
31
32  ! private & public routines
33
34  PRIVATE
35  PUBLIC vmax, vmax_clear
36
37  ! first call
38  LOGICAL, SAVE                                              :: firstcall_vmax = .TRUE.
39!$OMP THREADPRIVATE(firstcall_vmax)
40
41CONTAINS
42
43!! ================================================================================================================================
44!! SUBROUTINE   : vmax_clear
45!!
46!>\BRIEF          Flag setting
47!!
48!!\n DESCRIPTION: This subroutine sets flags ::firstcall_vmax, to .TRUE., and therefore activates   
49!!                section 1.1 of the ::vmax subroutine which writes messages to the output. \n
50!!                This subroutine is called at the end of the subroutine ::stomate_clear, in the
51!!                module ::stomate.
52!!
53!! RECENT CHANGE(S):None
54!!
55!! MAIN OUTPUT VARIABLE(S): ::firstcall_vmax
56!!
57!! REFERENCE(S)  : None
58!!
59!! FLOWCHART     : None
60!! \n             
61!_ =================================================================================================================================
62
63  SUBROUTINE vmax_clear
64    firstcall_vmax=.TRUE.
65  END SUBROUTINE vmax_clear
66
67
68
69!! ================================================================================================================================
70!! SUBROUTINE    : vmax
71!!
72!>\BRIEF         This subroutine computes vcmax photosynthesis parameters
73!! given optimal vcmax parameter values and a leaf age-related efficiency.
74!!
75!! DESCRIPTION (functional, design, flags):
76!! Leaf age classes are introduced to take into account the fact that photosynthetic activity depends on leaf age
77!! (Ishida et al., 1999). There are \f$nleafages\f$ classes (constant defined in stomate_constants.f90).
78!! This subroutine first calculates the new age of each leaf age-class based on fraction of leaf
79!! that goes from one to another class.                                             
80!! Then calculation of the new fraction of leaf in each class is performed.     
81!! Last, leaf efficiency is calculated for each PFT and for each leaf age class.
82!! vcmax is defined as vcmax25 and vjmax_opt weighted by a mean leaf
83!! efficiency. vcmax25 is PFT-dependent constants defined in constants_mtc.f90.
84!!
85!! This routine is called once at the beginning by stomate_var_init and then at each stomate time step by stomateLpj.
86!!
87!! RECENT CHANGE(S): None
88!!
89!! MAIN OUTPUT VARIABLE(S): vcmax
90!!
91!! REFERENCE(S) :
92!! - Ishida, A., A. Uemura, N. Koike, Y. Matsumoto, and A. Lai Hoe (1999),
93!! Interactive effects of leaf age and self-shading on leaf structure, photosynthetic
94!! capacity and chlorophyll fluorescence in the rain forest tree,
95!! dryobalanops aromatica, Tree Physiol., 19, 741-747
96!!
97!! FLOWCHART    : None
98!!
99!! REVISION(S)  : None
100!! \n
101!_ ================================================================================================================================
102
103  SUBROUTINE vmax (npts, dt, &
104       leaf_age, leaf_frac, &
105       vcmax)
106
107    !
108    !! 0. Variable and parameter declaration
109    !
110
111    !
112    !! 0.1 Input variables
113    !
114    INTEGER(i_std), INTENT(in)                                 :: npts                    !! Domain size (unitless)
115    REAL(r_std), INTENT(in)                                    :: dt                      !! time step of stomate (days)
116
117    !
118    !! 0.2 Output variables
119    !
120    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax                   !! Maximum rate of carboxylation
121                                                                                          !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
122
123    !
124    !! 0.3 Modified variables
125    !
126    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age                !! Leaf age (days)
127    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac               !! fraction of leaves in leaf age
128                                                                                          !! classes
129                                                                                          !! (unitless)
130
131    !
132    !! 0.4 Local variables
133    !
134    REAL(r_std), DIMENSION(npts)                               :: leaf_efficiency         !! leaf efficiency (vcmax/vcmax25)
135                                                                                          !! (unitless)
136    REAL(r_std), DIMENSION(npts,nvm,nleafages)                 :: d_leaf_frac             !! turnover between age classes
137                                                                                          !! (unitless)
138    REAL(r_std), DIMENSION(npts,nleafages)                     :: leaf_age_new            !! new leaf age (days)
139    REAL(r_std), DIMENSION(npts)                               :: sumfrac                 !! sum of leaf age fractions,
140                                                                                          !! for normalization
141                                                                                          !! (unitless)
142    REAL(r_std), DIMENSION(npts)                               :: rel_age                 !! relative leaf age (age/critical age)
143                                                                                          !! (unitless)
144    INTEGER(i_std)                                             :: j,m                     !! indices (unitless)
145
146!_ ================================================================================================================================
147
148    IF (printlev>=3) WRITE(numout,*) 'Entering vmax'
149
150    !
151    !! 1 Initialization
152    !
153
154    !
155    !! 1.1 first call: info about flags and parameters.
156    !
157
158    IF ( firstcall_vmax ) THEN
159       
160       IF (printlev >= 2) THEN
161          WRITE(numout,*) 'vmax:'
162
163          WRITE(numout,*) '   > offset (minimum vcmax/vmax_opt):' , vmax_offset
164          WRITE(numout,*) '   > relative leaf age at which vmax reaches vcmax_opt:', leafage_firstmax 
165          WRITE(numout,*) '   > relative leaf age at which vmax falls below vcmax_opt:', leafage_lastmax
166          WRITE(numout,*) '   > relative leaf age at which vmax reaches its minimum:', leafage_old
167       END IF
168       firstcall_vmax = .FALSE.
169
170    ENDIF
171
172    !
173    !! 1.2 initialize output
174    !
175
176    vcmax(:,:) = zero
177
178    !
179    !! 2 leaf age: general increase and turnover between age classes.
180    !
181
182    !
183    !! 2.1 increase leaf age
184    !
185!
186!! The age of the leaves in each leaf-age-class increases by 1 time step.
187    DO m = 1, nleafages ! Loop over # leaf age classes
188       DO j = 2,nvm     ! Loop over # PFTs
189          WHERE ( leaf_frac(:,j,m) .GT. min_stomate )
190
191             leaf_age(:,j,m) = leaf_age(:,j,m) + dt
192             
193          ENDWHERE
194       ENDDO    ! Loop over # PFTs
195
196    ENDDO       ! Loop over # leaf age classes
197
198    !
199    !! 2.2 turnover between leaf age classes
200    !     d_leaf_frac(:,:,m) = what leaves m-1 and goes into m
201    !
202
203    DO j = 2,nvm        ! Loop over # PFTs
204
205       !! 2.2.1 fluxes
206
207       !! nothing goes into first age class
208       d_leaf_frac(:,j,1) = zero
209
210       !! for others age classes (what goes from m-1 to m)
211       DO m = 2, nleafages 
212!! leaf_timecst is defined in stomate_constants.f90 as the quotient of the critical leaf age per the number of age classes.
213!! The critical leaf age is a PFT-dependent constant defined in stomate_constants.f90, that represents the leaf life span.
214!! This time constant (leaf_timecst) determines the turnover between the nleafages different leaf age classes
215!! (see section [118] in Krinner et al. (2005)).
216          d_leaf_frac(:,j,m) = leaf_frac(:,j,m-1) * dt/leaf_timecst(j)
217
218       ENDDO
219
220       !! 2.2.2 new leaf age in class
221       !!       new age = ( old age * (old fraction - fractional loss) + fractional increase * age of the source class ) / new fraction
222       !!       The leaf age of the youngest class (m=1) is updated into stomate_alloc         
223       leaf_age_new(:,:) = zero
224
225       DO m = 2, nleafages-1       ! Loop over age classes
226        !! For all age classes except first and last
227          WHERE ( d_leaf_frac(:,j,m) .GT. min_stomate )
228
229             leaf_age_new(:,m) = ( ( (leaf_frac(:,j,m)- d_leaf_frac(:,j,m+1)) * leaf_age(:,j,m) )  + &
230                  ( d_leaf_frac(:,j,m) * leaf_age(:,j,m-1) ) ) / &
231                  ( leaf_frac(:,j,m) + d_leaf_frac(:,j,m)- d_leaf_frac(:,j,m+1) )
232
233          ENDWHERE
234
235       ENDDO       ! Loop over age classes
236
237        !! For last age class, there is no leaf fraction leaving the class.
238
239       WHERE ( d_leaf_frac(:,j,nleafages) .GT. min_stomate )
240
241          leaf_age_new(:,nleafages) = ( ( leaf_frac(:,j,nleafages) * leaf_age(:,j,nleafages) )  + &
242               ( d_leaf_frac(:,j,nleafages) * leaf_age(:,j,nleafages-1) ) ) / &
243               ( leaf_frac(:,j,nleafages) + d_leaf_frac(:,j,nleafages) )
244
245       ENDWHERE
246
247       DO m = 2, nleafages       ! Loop over age classes
248
249          WHERE ( d_leaf_frac(:,j,m) .GT. min_stomate )
250
251             leaf_age(:,j,m) = leaf_age_new(:,m)
252
253          ENDWHERE
254
255       ENDDO       ! Loop over age classes
256
257       !! 2.2.3 calculate new fraction
258
259       DO m = 2, nleafages       ! Loop over age classes
260
261          ! where the change comes from
262          leaf_frac(:,j,m-1) = leaf_frac(:,j,m-1) - d_leaf_frac(:,j,m)
263
264          ! where it goes to
265          leaf_frac(:,j,m) = leaf_frac(:,j,m) + d_leaf_frac(:,j,m)
266
267       ENDDO       ! Loop over age classes
268
269       !! 2.2.4 renormalize fractions in order to prevent accumulation
270       !       of numerical errors
271
272       ! correct small negative values
273
274       DO m = 1, nleafages
275          leaf_frac(:,j,m) = MAX( zero, leaf_frac(:,j,m) )
276       ENDDO
277
278       ! total of fractions, should be very close to one where there is leaf mass
279
280       sumfrac(:) = zero
281
282       DO m = 1, nleafages       ! Loop over age classes
283
284          sumfrac(:) = sumfrac(:) + leaf_frac(:,j,m)
285
286       ENDDO       ! Loop over age classes
287
288       ! normalize
289
290       DO m = 1, nleafages       ! Loop over age classes
291
292          WHERE ( sumfrac(:) .GT. min_stomate )
293
294             leaf_frac(:,j,m) = leaf_frac(:,j,m) / sumfrac(:) 
295
296          ELSEWHERE
297
298             leaf_frac(:,j,m) = zero
299
300          ENDWHERE
301
302       ENDDO       ! Loop over age classes
303
304    ENDDO         ! Loop over PFTs
305
306    !
307    !! 3 calculate vmax as a function of the age
308    !
309
310    DO j = 2,nvm
311
312       vcmax(:,j) = zero
313
314       ! sum up over the different age classes
315       IF (ok_dgvm .AND. pheno_type(j)==1 .AND. leaf_tab(j)==2) THEN
316          ! pheno_typ=evergreen and leaf_tab=needleleaf
317          vcmax(:,j) = Vcmax25(j)
318
319       ELSE 
320          ! for deciduous tree
321          DO m = 1, nleafages       ! Loop over age classes
322
323             !
324             !! 3.1 efficiency in each of the age classes
325             !!     it varies from vmax_offset to 1
326             !!     linearly increases from vmax_offset to 1 for 0 < rel_age < leafage_firstmax
327             !!     is 1 when leafage_firstmax < rel_age < leafage_lastmax
328             !!     linearly decreases from 1 to vmax_offset for leafage_lastmax < rel_age < leafage_firstmax
329             !!     vmax_offset for rel_age >= leafage_old
330             !!     (Ishida et al., 1999)
331             rel_age(:) = leaf_age(:,j,m) / leafagecrit(j)
332
333             leaf_efficiency(:) = MAX( vmax_offset, MIN( un, &
334                  vmax_offset + (un - vmax_offset) * rel_age(:) / leafage_firstmax, &
335                  un - (un - vmax_offset) * ( rel_age(:) - leafage_lastmax ) / &
336                  ( leafage_old - leafage_lastmax ) ) )
337
338             !
339             !! 3.2 add to mean vmax
340             !             
341             vcmax(:,j) = vcmax(:,j) + Vcmax25(j) * leaf_efficiency(:) * leaf_frac(:,j,m)
342
343          ENDDO     ! loop over age classes
344       ENDIF
345
346    ENDDO       ! loop over PFTs
347
348    IF (printlev>=4) WRITE(numout,*) 'Leaving vmax'
349
350  END SUBROUTINE vmax
351
352END MODULE stomate_vmax
Note: See TracBrowser for help on using the repository browser.