source: tags/ORCHIDEE/src_stomate/stomate_alloc.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: 19.7 KB
Line 
1! allocation to the roots, stems, leaves, "fruits" and carbohydrate reserve.
2! Reproduction: for the moment, this is simply a 10% "tax".
3! This should depend on the limitations that the plant experiences. If the
4! plant fares well, it will have fruits. However, this means that we should
5! also "reward" the plants for having grown fruits by making the
6! reproduction rate depend on the fruit growth of the past years. Otherwise,
7! the fruit allocation would be a punishment for plants that are doing well.
8! "calculates" root profiles (in fact, prescribes it for the moment).
9!
10! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_alloc.f90,v 1.10 2009/03/31 12:11:22 ssipsl Exp $
11! IPSL (2006)
12!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
13!
14MODULE stomate_alloc
15
16  ! modules used:
17
18  USE ioipsl
19  USE stomate_constants
20  USE constantes_veg
21
22  IMPLICIT NONE
23
24  ! private & public routines
25
26  PRIVATE
27  PUBLIC alloc,alloc_clear
28
29  ! first call
30  LOGICAL, SAVE                                             :: firstcall = .TRUE.
31CONTAINS
32  SUBROUTINE alloc_clear
33    firstcall = .TRUE.
34  END SUBROUTINE alloc_clear
35
36  SUBROUTINE alloc (npts, dt, &
37       lai, veget_max, senescence, when_growthinit, &
38       moiavail_week, tsoil_month, soilhum_month, &
39       biomass, age, leaf_age, leaf_frac, rprof, f_alloc)
40
41    !
42    ! 0 declarations
43    !
44
45    ! 0.1 input
46
47    ! Domain size
48    INTEGER(i_std), INTENT(in)                                       :: npts
49    ! time step (days)
50    REAL(r_std), INTENT(in)                                    :: dt
51    ! Leaf area index
52    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai
53    ! "maximal" coverage fraction of a PFT ( = ind*cn_ind )
54    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max
55    ! is the plant senescent? (only for deciduous trees - carbohydrate reserve)
56    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: senescence
57    ! how many days ago was the beginning of the growing season
58    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: when_growthinit
59    ! "weekly" moisture availability
60    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: moiavail_week
61    ! "monthly" soil temperature (K)
62    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_month
63    ! "monthly" soil humidity
64    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_month
65    !  age (days)
66    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: age
67
68    ! 0.2 modified fields
69
70    ! biomass (gC/m**2)
71    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)    :: biomass
72    ! leaf age (days)
73    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age
74    ! fraction of leaves in leaf age class
75    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac
76
77    ! 0.3 output
78
79    ! root depth. This will, one day, be a prognostic variable. It will be calculated by
80    ! STOMATE (save in restart file & give to hydrology module!). For the moment, it
81    ! is prescribed.
82    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: rprof
83    ! fraction that goes into plant part
84    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out)      :: f_alloc
85
86    ! 0.4 local
87
88    ! Do we try to reach a minimum reservoir even if we are severely stressed?
89    LOGICAL, PARAMETER                                        :: ok_minres = .TRUE.
90    ! time (d) to attain the initial foliage using the carbohydrate reserve
91    REAL(r_std), PARAMETER                                     :: tau_leafinit = 10.
92    ! maximum time (d) during which reserve is used (trees)
93    REAL(r_std), PARAMETER                                     :: reserve_time_tree = 30.
94    ! maximum time (d) during which reserve is used (grasses)
95    REAL(r_std), PARAMETER                                     :: reserve_time_grass = 20.
96    ! Standard root allocation
97    REAL(r_std), PARAMETER                                     :: R0 = 0.3
98    ! Standard sapwood allocation
99    REAL(r_std), PARAMETER                                     :: S0 = 0.3
100    ! Standard leaf allocation
101    REAL(r_std), PARAMETER                                     :: L0 = 1. - R0 - S0
102    ! Standard fruit allocation
103    REAL(r_std), PARAMETER                                     :: f_fruit = 0.1
104    ! fraction of sapwood allocation above ground (SHOULD BE CALCULATED !!!!)
105    REAL(r_std), PARAMETER                                     :: alloc_sap_above_tree = 0.5
106    REAL(r_std), PARAMETER                                     :: alloc_sap_above_grass = 1.0
107    ! extrema of leaf allocation fraction
108    REAL(r_std), PARAMETER                                     :: min_LtoLSR = 0.2
109    REAL(r_std), PARAMETER                                     :: max_LtoLSR = 0.5
110    ! below this lai, the carbohydrate reserve is used
111    REAL(r_std), DIMENSION(nvm)                               :: lai_happy
112    ! limiting factor light
113    REAL(r_std), DIMENSION(npts)                               :: limit_L
114    ! limiting factor nitrogen
115    REAL(r_std), DIMENSION(npts)                               :: limit_N
116    ! factors determining limit_N: 1/ temperature
117    REAL(r_std), DIMENSION(npts)                               :: limit_N_temp
118    ! factors determining limit_N: 2/ humidity
119    REAL(r_std), DIMENSION(npts)                               :: limit_N_hum
120    ! limiting factor water
121    REAL(r_std), DIMENSION(npts)                               :: limit_W
122    ! limiting factor in soil (nitrogen or water)
123    REAL(r_std), DIMENSION(npts)                               :: limit_WorN
124    ! limit: strongest limitation amongst limit_N, limit_W and limit_L
125    REAL(r_std), DIMENSION(npts)                               :: limit
126    ! scaling depth for nitrogen limitation (m)
127    REAL(r_std), PARAMETER                                     :: z_nitrogen = 0.2
128    ! soil temperature used for N parameterization
129    REAL(r_std), DIMENSION(npts)                               :: t_nitrogen
130    ! soil humidity used for N parameterization
131    REAL(r_std), DIMENSION(npts)                               :: h_nitrogen
132    ! integration constant for vertical profiles
133    REAL(r_std), DIMENSION(npts)                               :: rpc
134    ! ratio between leaf-allocation and (leaf+sapwood+root)-allocation
135    REAL(r_std), DIMENSION(npts)                               :: LtoLSR
136    ! ratio between sapwood-allocation and (leaf+sapwood+root)-allocation
137    REAL(r_std), DIMENSION(npts)                               :: StoLSR
138    ! ratio between root-allocation and (leaf+sapwood+root)-allocation
139    REAL(r_std), DIMENSION(npts)                               :: RtoLSR
140    ! rescaling factor for carbohydrate reserve allocation
141    REAL(r_std), DIMENSION(npts)                               :: carb_rescale
142    ! mass taken from carbohydrate reserve (gC/m**2)
143    REAL(r_std), DIMENSION(npts)                               :: use_reserve
144    ! mass taken from carbohydrate reserve and put into leaves (gC/m**2)
145    REAL(r_std), DIMENSION(npts)                               :: transloc_leaf
146    ! mass in youngest leaf age class (gC/m**2)
147    REAL(r_std), DIMENSION(npts)                               :: leaf_mass_young
148    ! old leaf biomass (gC/m**2)
149    REAL(r_std), DIMENSION(npts,nvm)                          :: lm_old
150    ! maximum time (d) during which reserve is used
151    REAL(r_std)                                                :: reserve_time
152    ! lai on natural part of the grid cell, or of this agricultural PFT
153    REAL(r_std), DIMENSION(npts,nvm)                          :: lai_around
154    ! vegetation cover of natural PFTs on the grid cell (agriculture masked)
155    REAL(r_std), DIMENSION(npts,nvm)                          :: veget_max_nat 
156    ! total natural vegetation cover on natural part of the grid cell
157    REAL(r_std), DIMENSION(npts)                               :: natveg_tot
158    ! average LAI on natural part of the grid cell
159    REAL(r_std), DIMENSION(npts)                               :: lai_nat
160    ! intermediate array for looking for minimum
161    REAL(r_std), DIMENSION(npts)                               :: zdiff_min
162    ! fraction of sapwood allocation above ground (SHOULD BE CALCULATED !!!!)
163    REAL(r_std), DIMENSION(npts)                               :: alloc_sap_above
164    ! soil levels (m)
165    REAL(r_std), SAVE, DIMENSION(0:nbdl)                       :: z_soil
166    ! Index
167    INTEGER(i_std)                                            :: i,j,l,m
168
169    ! =========================================================================
170
171    IF (bavard.GE.3) WRITE(numout,*) 'Entering alloc'
172
173    !
174    ! 1 Initialization
175    !
176
177    !
178    ! 1.1 first call
179    !
180
181    IF ( firstcall ) THEN
182
183       ! 1.1.1 soil levels
184
185       z_soil(0) = 0.
186       z_soil(1:nbdl) = diaglev(1:nbdl)
187
188       ! 1.1.2 info about flags and parameters.
189
190       WRITE(numout,*) 'alloc:'
191
192       WRITE(numout,'(a,$)') '    > We'
193       IF ( .NOT. ok_minres ) WRITE(numout,'(a,$)') ' do NOT'
194       WRITE(numout,*) 'try to reach a minumum reservoir when severely stressed.'
195
196       WRITE(numout,*) '   > Time to put initial leaf mass on (d): ',tau_leafinit
197
198       WRITE(numout,*) '   > scaling depth for nitrogen limitation (m): ', &
199            z_nitrogen
200
201       WRITE(numout,*) '   > sap allocation above the ground / total sap allocation: '
202       WRITE(numout,*) '       trees:', alloc_sap_above_tree
203       WRITE(numout,*) '       grasses:', alloc_sap_above_grass
204
205       WRITE(numout,*) '   > standard root alloc fraction: ', R0
206
207       WRITE(numout,*) '   > standard sapwood alloc fraction: ', S0
208
209       WRITE(numout,*) '   > standard fruit allocation: ', f_fruit
210
211       WRITE(numout,*) '   > minimum/maximum leaf alloc fraction: ', min_LtoLSR,max_LtoLSR
212
213       WRITE(numout,*) '   > maximum time (d) during which reserve is used:'
214       WRITE(numout,*) '       trees:',reserve_time_tree
215       WRITE(numout,*) '       grasses:',reserve_time_grass
216
217       firstcall = .FALSE.
218
219    ENDIF
220
221    !
222    ! 1.2 initialize output
223    !
224
225    f_alloc(:,:,:) = 0.0
226    f_alloc(:,:,icarbres) = 1.0
227    !
228    ! 1.3 Convolution of the temperature and humidity profiles with some kind of profile
229    !     of microbial density gives us a representative temperature and humidity
230    !
231
232    ! 1.3.1 temperature
233
234    ! 1.3.1.1 rpc is an integration constant such that the integral of the root profile is 1.
235    rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
236
237    ! 1.3.1.2 integrate over the nbdl levels
238
239    t_nitrogen(:) = 0.
240
241    DO l = 1, nbdl
242
243       t_nitrogen(:) = &
244            t_nitrogen(:) + tsoil_month(:,l) * rpc(:) * &
245            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
246
247    ENDDO
248
249    ! 1.3.2 moisture
250
251    ! 1.3.2.1 rpc is an integration constant such that the integral of the root profile is 1.
252    rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
253
254    ! 1.3.2.2 integrate over the nbdl levels
255
256    h_nitrogen(:) = 0.0
257
258    DO l = 1, nbdl
259
260       h_nitrogen(:) = &
261            h_nitrogen(:) + soilhum_month(:,l) * rpc(:) * &
262            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
263
264    ENDDO
265
266    !
267    ! 1.4 for light limitation: lai on natural part of the grid cell or lai of this
268    !       agricultural PFT
269    !
270
271    ! mask agricultural vegetation
272    ! mean LAI on natural part
273
274    natveg_tot(:) = 0.0
275    lai_nat(:) = 0.0
276
277    DO j = 2, nvm
278
279       IF ( natural(j) ) THEN
280          veget_max_nat(:,j) = veget_max(:,j)
281       ELSE
282          veget_max_nat(:,j) = 0.0
283       ENDIF
284
285       ! sum up fraction of natural space covered by vegetation
286       natveg_tot(:) = natveg_tot(:) + veget_max_nat(:,j)
287
288       ! sum up lai
289       lai_nat(:) = lai_nat(:) + veget_max_nat(:,j) * lai(:,j)
290
291    ENDDO
292
293    DO j = 2, nvm
294
295       IF ( natural(j) ) THEN
296          lai_around(:,j) = lai_nat(:)
297       ELSE
298          lai_around(:,j) = lai(:,j)
299       ENDIF
300
301    ENDDO
302
303    !
304    ! 1.5 LAI below which carbohydrate reserve is used
305    !
306
307    lai_happy(:) = lai_max(:) * 0.5
308
309    !
310    ! 2 Use carbohydrate reserve
311    !   This time constant implicitly takes into account the dispersion of the budburst
312    !   data. Therefore, it might be decreased at lower resolution.
313    !
314
315    ! save old leaf mass
316
317    lm_old(:,:) = biomass(:,:,ileaf)
318
319    DO j = 2, nvm
320
321       !
322       ! 2.1 determine mass to be translocated to leaves and roots
323       !
324
325       ! determine maximum time during which reserve is used
326
327       IF ( tree(j) ) THEN
328          reserve_time = reserve_time_tree
329       ELSE
330          reserve_time = reserve_time_grass
331       ENDIF
332
333       ! conditions: 1/ plant must not be senescent
334       !             2/ lai must be relatively low
335       !             3/ must be at the beginning of the growing season
336
337       WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. & 
338            ( .NOT. senescence(:,j) ) .AND. &
339            ( lai(:,j) .LT. lai_happy(j) ) .AND. &
340            ( when_growthinit(:,j) .LT. reserve_time ) ) 
341
342          ! determine mass to put on
343          use_reserve(:) = &
344               MIN( biomass(:,j,icarbres), &
345               2._r_std * dt/tau_leafinit * lai_happy(j)/ sla(j) )
346
347          ! grow leaves and fine roots
348
349          transloc_leaf(:) = L0/(L0+R0) * use_reserve(:)
350
351          biomass(:,j,ileaf) = biomass(:,j,ileaf) + transloc_leaf(:)
352          biomass(:,j,iroot) = biomass(:,j,iroot) + ( use_reserve(:) - transloc_leaf(:) )
353
354          ! decrease reserve mass
355
356          biomass(:,j,icarbres) = biomass(:,j,icarbres) - use_reserve(:)
357
358       ELSEWHERE
359
360          transloc_leaf(:) = 0.0
361
362       ENDWHERE
363
364       !
365       ! 2.2 update leaf age
366       !
367
368       ! 2.2.1 Decrease leaf age in youngest class.
369
370       leaf_mass_young(:) = leaf_frac(:,j,1) * lm_old(:,j) + transloc_leaf(:)
371
372       WHERE ( ( transloc_leaf(:) .GT. min_stomate ) .AND. ( leaf_mass_young(:) .GT. min_stomate ) )
373
374          leaf_age(:,j,1) = MAX( zero, leaf_age(:,j,1) * ( leaf_mass_young(:) - transloc_leaf(:) ) / &
375               leaf_mass_young(:) )
376
377       ENDWHERE
378
379       ! 2.2.2 new age class fractions (fraction in youngest class increases)
380
381       ! 2.2.2.1 youngest class: new mass in youngest class divided by total new mass
382
383       WHERE ( biomass(:,j,ileaf) .GT. min_stomate )
384
385          leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf)
386
387       ENDWHERE
388
389       ! 2.2.2.2 other classes: old mass in leaf age class divided by new mass
390
391       DO m = 2, nleafages
392
393          WHERE ( biomass(:,j,ileaf) .GT. min_stomate )
394
395             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf)
396
397          ENDWHERE
398
399       ENDDO
400
401    ENDDO         ! loop over PFTs
402
403    !
404    ! 3 Calculate fractional allocation.
405    !   The fractions of NPP allocated to the different compartments depend on the
406    !   availability of light, water, and nitrogen.
407    !
408
409    DO j = 2, nvm
410
411       RtoLSR(:)=0
412       LtoLSR(:)=0
413       StoLSR(:)=0
414
415       ! for the moment, fixed partitioning between above and below the ground
416       ! modified by JO/NV/PF for changing partitioning with stand age
417       ! we could have alloc_sap_above(npts,nvm) but we have only
418       ! alloc_sap_above(npts) as we make a loop over j=2,nvm
419       !
420       IF ( tree(j) ) THEN
421
422          alloc_sap_above (:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(1.-EXP(-age(:,j)/demi_alloc(j)))
423
424          !IF (j .EQ. 3) WRITE(*,*) '%allocated above = 'alloc_sap_above(1),'age = ',age(1,j)
425       ELSE
426          alloc_sap_above(:) = alloc_sap_above_grass
427       ENDIF
428
429       ! only where leaves are on
430
431       WHERE ( biomass(:,j,ileaf) .GT. min_stomate )
432
433          !
434          ! 3.1 Limiting factors: weak value = strong limitation
435          !
436
437          ! 3.1.1 Light: depends on mean lai on the natural part of the
438          !       grid box (light competition).
439          !       For agricultural PFTs, take its own lai for both parts.
440          !MM, NV
441          WHERE( lai_around(:,j) < 10 )
442             limit_L(:) = MAX( 0.1_r_std, EXP( -0.5_r_std * lai_around(:,j) ) )
443          ELSEWHERE
444             limit_L(:) = 0.1_r_std
445          ENDWHERE
446          ! 3.1.2 Water
447
448          limit_W(:) = MAX( 0.1_r_std, MIN( 1._r_std, moiavail_week(:,j) ) )
449
450          ! 3.1.3 Nitrogen supply: depends on water and temperature
451          !       Agricultural PFTs can be limited by Nitrogen for the moment ...
452          !       Replace this once there is a nitrogen cycle in STOMATE !
453
454          ! 3.1.3.1 water
455
456          limit_N_hum(:) = MAX( 0.5_r_std, MIN( 1._r_std, h_nitrogen(:) ) )
457
458          ! 3.1.3.2 temperature
459
460          limit_N_temp(:) = 2.**((t_nitrogen(:)-ZeroCelsius-25.)/10.)
461          limit_N_temp(:) = MAX( 0.1_r_std, MIN( 1._r_std, limit_N_temp(:) ) )
462
463          ! 3.1.3.3 combine water and temperature factors to get nitrogen limitation
464
465          limit_N(:) = MAX( 0.1_r_std, MIN( 1._r_std, limit_N_hum(:) * limit_N_temp(:) ) )
466
467          ! 3.1.4 Among water and nitrogen, take the one that is more limited
468
469          limit_WorN(:) = MIN( limit_W(:), limit_N(:) )
470
471          ! 3.1.5 strongest limitation
472
473          limit(:) = MIN( limit_WorN(:), limit_L(:) )
474
475          !
476          ! 3.2 Ratio between allocation to leaves, sapwood and roots
477          !
478
479          ! preliminary root allocation
480
481          RtoLSR(:) = &
482               MAX( .15_r_std, &
483               R0 * 3._r_std * limit_L(:) / ( limit_L(:) + 2._r_std * limit_WorN(:) ) )
484
485          ! sapwood allocation
486
487          StoLSR(:) = S0 * 3. * limit_WorN(:) / ( 2. * limit_L(:) + limit_WorN(:) )
488
489          ! leaf allocation
490
491          LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:)
492          LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
493
494          ! roots: the rest
495
496          RtoLSR(:) = 1. - LtoLSR(:) - StoLSR(:)
497
498       ENDWHERE
499
500       ! no leaf allocation if LAI beyond maximum LAI. Biomass then goes into sapwood
501
502       WHERE ( (biomass(:,j,ileaf) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
503
504          StoLSR(:) = StoLSR(:) + LtoLSR(:)
505
506          LtoLSR(:) = 0.0
507
508       ENDWHERE
509
510       !
511       ! 3.3 final allocation
512       !
513
514       DO i = 1, npts
515
516          IF ( biomass(i,j,ileaf) .GT. min_stomate ) THEN
517
518             IF ( senescence(i,j) ) THEN
519
520                ! 3.3.1 senescent: everything goes into carbohydrate reserve
521
522                f_alloc(i,j,icarbres) = 1.0
523
524             ELSE
525
526                ! 3.3.2 in growing season
527
528                ! to fruits
529                f_alloc(i,j,ifruit) = f_fruit
530
531                ! allocation to the reserve is proportional to the leaf and root allocation.
532                ! Leaf, root, and sap allocation are rescaled.
533                ! No allocation to reserve if there is much biomass in it
534                !   (more than the maximum LAI: in that case, rescale=1)
535
536                IF ( ( biomass(i,j,icarbres)*sla(j) ) .LT. 2*lai_max(j) ) THEN
537                   carb_rescale(i) = 1. / ( 1. + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
538                ELSE
539                   carb_rescale(i) = 1.
540                ENDIF
541
542                f_alloc(i,j,ileaf) = LtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i)
543
544                f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
545                     ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i)
546                f_alloc(i,j,isapbelow) = StoLSR(i) * ( 1. - alloc_sap_above(i) ) * &
547                     ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i)
548
549                f_alloc(i,j,iroot) = RtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i)
550
551                ! this is equivalent to:
552                ! reserve alloc = ecureuil*(LtoLSR+StoLSR)*(1-fruit_alloc)*carb_rescale
553                f_alloc(i,j,icarbres) = ( 1. - carb_rescale(i) ) * ( 1.-f_alloc(i,j,ifruit) )
554
555             ENDIF  ! senescent?
556
557          ENDIF    ! there are leaves
558
559       ENDDO      ! Fortran95: double WHERE construct
560
561    ENDDO          ! loop over PFTs
562
563    !
564    ! 4 root profile
565    !
566
567
568    IF (bavard.GE.4) WRITE(numout,*) 'Leaving alloc'
569
570  END SUBROUTINE alloc
571
572
573END MODULE stomate_alloc
Note: See TracBrowser for help on using the repository browser.