Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_alloc.f90 @ 880

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: