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 | ! |
---|
14 | MODULE 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. |
---|
31 | CONTAINS |
---|
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 = un - 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 = un |
---|
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) = zero |
---|
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(:,:,:) = zero |
---|
226 | f_alloc(:,:,icarbres) = un |
---|
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(:) = un / ( un - 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(:) = un / ( un - EXP( -z_soil(nbdl) / z_nitrogen ) ) |
---|
253 | |
---|
254 | ! 1.3.2.2 integrate over the nbdl levels |
---|
255 | |
---|
256 | h_nitrogen(:) = zero |
---|
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(:) = zero |
---|
275 | lai_nat(:) = zero |
---|
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) = zero |
---|
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. zero ) .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(:) = zero |
---|
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(:) = un - RtoLSR(:) - StoLSR(:) |
---|
492 | LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) ) |
---|
493 | |
---|
494 | ! roots: the rest |
---|
495 | |
---|
496 | RtoLSR(:) = un - 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(:) = zero |
---|
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) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) ) |
---|
538 | ELSE |
---|
539 | carb_rescale(i) = un |
---|
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 | ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i) |
---|
546 | f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * & |
---|
547 | ( un - 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) = ( un - 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 | |
---|
573 | END MODULE stomate_alloc |
---|