Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

stomate_alloc.f90 @ 6145

Last change on this file since 6145 was 4977, checked in by simon.bowring, 6 years ago
Currently running (13/02/2018) version includes all necessarily changes to include DOC in MICT code... further parametrisation necessary to equate soil pools with those of normal forcesoil restarts
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 45.2 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_alloc
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF Allocate net primary production to: carbon reserves, aboveground sapwood,
10	!! belowground sapwood, root, fruits and leaves.
11	!!
12	!!\n DESCRIPTION: None
13	!!
14	!! RECENT CHANGE(S): None
15	!!
16	!! REFERENCE(S) :
17	!!
18	!! SVN :
19	!! $HeadURL$
20	!! $Date$
21	!! $Revision$
22	!! \n
23	!_ ================================================================================================================================
24
25	MODULE stomate_alloc
26
27	! Modules used:
28
29	USE ioipsl_para
30	USE pft_parameters
31	USE stomate_data
32	USE constantes
33	USE constantes_soil
34
35	IMPLICIT NONE
36
37	! Private & public routines
38
39	PRIVATE
40	PUBLIC alloc,alloc_clear
41
42	! Variables shared by all subroutines in this module
43
44	LOGICAL, SAVE :: firstcall_alloc = .TRUE. !! Is this the first call? (true/false)
45	!$OMP THREADPRIVATE(firstcall_alloc)
46	CONTAINS
47
48
49	!! ================================================================================================================================
50	!! SUBROUTINE : alloc_clear
51	!!
52	!>\BRIEF Set the flag ::firstcall_alloc to .TRUE. and as such activate section
53	!! 1.1 of the subroutine alloc (see below).\n
54	!!
55	!_ ================================================================================================================================
56
57	SUBROUTINE alloc_clear
58	firstcall_alloc = .TRUE.
59	END SUBROUTINE alloc_clear
60
61
62
63	!! ================================================================================================================================
64	!! SUBROUTINE : alloc
65	!!
66	!>\BRIEF Allocate net primary production (= photosynthesis
67	!! minus autothrophic respiration) to: carbon reserves, aboveground sapwood,
68	!! belowground sapwood, root, fruits and leaves following Friedlingstein et al. (1999).
69	!!
70	!! DESCRIPTION (definitions, functional, design, flags):\n
71	!! The philosophy underlying the scheme is that allocation patterns result from
72	!! evolved responses that adjust carbon investments to facilitate capture of most
73	!! limiting resources i.e. light, water and mineral nitrogen. The implemented scheme
74	!! calculates the limitation of light, water and nitrogen. However, nitrogen is not a
75	!! prognostic variable of the model and therefore soil temperature and soil moisture
76	!! are used as a proxy for soil nitrogen availability.\n
77	!! Sharpe & Rykiel (1991) proposed a generic relationship between the allocation of
78	!! carbon to a given plant compartment and the availability of a particular resource:\n
79	!! \latexonly
80	!! \input{alloc1.tex}
81	!! \endlatexonly
82	!! \n
83	!! where A is the allocation of biomass production (NPP) to a given compartment (either
84	!! leaves, stem, or roots). Xi and Yj are resource availabilities (e.g. light, water,
85	!! nutrient). For a given plant compartment, a resource can be of type X or Y. An increase
86	!! in a X-type resource will increase the allocation to compartment A. An increase in a
87	!! Y-type resource will, however, lead to a decrease in carbon allocation to that compartment.
88	!! In other words, Y-type resources are those for which uptake increases with increased
89	!! investment in the compartment in question. X-type resources, as a consequence of
90	!! trade-offs, are the opposite. For example, water is a Y-type resource for root allocation.
91	!! Water-limited conditions should promote carbon allocation to roots, which enhance water
92	!! uptake and hence minimize plant water stress. Negative relationships between investment
93	!! and uptake arise when increased investment in one compartment leads, as required for
94	!! conservation of mass, to decreased investment in a component involved in uptake of
95	!! that resource.\n
96	!!
97	!! The implemented scheme allocates carbon to the following components:\n
98	!! - Carbon reserves;\n
99	!! - Aboveground sapwood;\n
100	!! - Belowground sapwood;\n
101	!! - Roots;\n
102	!! - Fruits/seeds and\n
103	!! - Leaves.
104	!! \n
105	!!
106	!! The allocation to fruits and seeds is simply a 10% "tax" of the total biomass
107	!! production.\n
108	!! Following carbohydrate use to support budburst and initial growth, the
109	!! carbohydrate reserve is refilled. The daily amount of carbon allocated to the
110	!! reserve pool is proportional to leaf+root allocation (::LtoLSR and ::RtoLSR).\n
111	!! Sapwood and root allocation (respectively ::StoLSR and ::RtoLSR) are proportional
112	!! to the estimated light and soil (water and nitrogen) stress (::Limit_L and
113	!! ::Limit_NtoW). Further, Sapwood allocation is separated in belowground sapwood
114	!! and aboveground sapwood making use of the parameter (:: alloc_sap_above_tree
115	!! or ::alloc_sap_above_grass). For trees partitioning between above and
116	!! belowground compartments is a function of PFT age.\n
117	!! Leaf allocation (::LtoLSR) is calculated as the residual of root and sapwood
118	!! allocation (LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:).\n
119	!!
120	!! RECENT CHANGE(S): None
121	!!
122	!! MAIN OUTPUT VARIABLE(S): :: f_alloc; fraction of NPP that is allocated to the
123	!! six different biomass compartments (leaves, roots, above and belowground wood,
124	!! carbohydrate reserves and fruits). DIMENSION(npts,nvm,nparts).
125	!!
126	!! REFERENCE(S) :
127	!! - Friedlingstein, P., G. Joel, C.B. Field, and Y. Fung (1999), Towards an allocation
128	!! scheme for global terrestrial carbon models, Global Change Biology, 5, 755-770.\n
129	!! - Sharpe, P.J.H., and Rykiel, E.J. (1991), Modelling integrated response of plants
130	!! to multiple stresses. In: Response of Plants to Multiple Stresses (eds Mooney, H.A.,
131	!! Winner, W.E., Pell, E.J.), pp. 205-224, Academic Press, San Diego, CA.\n
132	!! - Krinner G, Viovy N, de Noblet-Ducoudr N, Ogee J, Polcher J, Friedlingstein P,
133	!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
134	!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
135	!! doi: 10.1029/2003GB002199.\n
136	!! - Malhi, Y., Doughty, C., and Galbraith, D. (2011). The allocation of ecosystem net primary productivity in tropical forests,
137	!! Philosophical Transactions of the Royal Society B-Biological Sciences, 366, 3225-3245, DOI 10.1098/rstb.2011.0062.\n
138	!!
139	!! FLOWCHART :
140	!! \latexonly
141	!! \includegraphics[scale=0.5]{allocflow.jpg}
142	!! \endlatexonly
143	!! \n
144	!_ ================================================================================================================================
145
146	SUBROUTINE alloc (npts, dt, &
147	lai, veget_max, senescence, when_growthinit, &
148	moiavail_week, tsoil_month, soilhum_month, &
149	biomass, age, leaf_age, leaf_frac, rprof, f_alloc, &
150	deltai, ssla, & !added for crops, xuhui
151	!gmjc
152	sla_calc, when_growthinit_cut)
153	!end gmjc
154	!! 0. Variable and parameter declaration
155
156	!! 0.1 Input variables
157
158	INTEGER(i_std), INTENT(in) :: npts !! Domain size - number of grid cells
159	!! (unitless)
160	REAL(r_std), INTENT(in) :: dt !! Time step of the simulations for stomate
161	!! (days)
162	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lai !! PFT leaf area index
163	!! @tex $(m^2 m^{-2})$ @endtex
164	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max !! PFT "Maximal" coverage fraction of a PFT
165	!! (= ind*cn_ind)
166	!! @tex $(m^2 m^{-2})$ @endtex
167	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: senescence !! Is the PFT senescent? - only for
168	!! deciduous trees (true/false)
169	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit !! Days since beginning of growing season
170	!! (days)
171	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_week !! PFT moisture availability - integrated
172	!! over a week (0-1, unitless)
173	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_month !! PFT soil temperature - integrated over
174	!! a month (K)
175	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_month !! PFT soil humidity - integrated over a
176	!! month (0-1, unitless)
177	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: age !! PFT age (days)
178	! for STICS
179	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: deltai
180	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ssla
181	! end for STICS
182
183	!! 0.2 Output variables
184
185	!! 0.3 Modified variables
186
187	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass !! PFT total biomass
188	!! @tex $(gC m^{-2})$ @endtex
189	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age !! PFT age of different leaf classes
190	!! (days)
191	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac !! PFT fraction of leaves in leaf age class
192	!! (0-1, unitless)
193	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: rprof !! [DISPENSABLE] PFT rooting depth - not
194	!! calculated in the current version of
195	!! the model (m)
196	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: f_alloc !! PFT fraction of NPP that is allocated to
197	!! the different components (0-1, unitless)
198	!gmjc
199	! how many days ago was the beginning of the cut
200	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit_cut
201	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sla_calc
202	!end gmjc
203	!! 0.4 Local variables
204	REAL(r_std), DIMENSION(nvm) :: lai_happy !! Lai threshold below which carbohydrate
205	!! reserve may be used
206	!! @tex $(m^2 m^{-2})$ @endtex
207	REAL(r_std), DIMENSION(npts) :: limit_L !! Lights stress (0-1, unitless)
208	REAL(r_std), DIMENSION(npts) :: limit_N !! Total nitrogen stress (0-1, unitless)
209	REAL(r_std), DIMENSION(npts) :: limit_N_temp !! Stress from soil temperature on nitrogen
210	!! mineralisation (0-1, unitless)
211	REAL(r_std), DIMENSION(npts) :: limit_N_hum !! Stress from soil humidity on nitrogen
212	!! mineralisation (0-1, unitless)
213	REAL(r_std), DIMENSION(npts) :: limit_W !! Soil water stress (0-1, unitless)
214	REAL(r_std), DIMENSION(npts) :: limit_WorN !! Most limiting factor in the soil:
215	!! nitrogen or water (0-1, unitless)
216	REAL(r_std), DIMENSION(npts) :: limit !! Most limiting factor: amongst limit_N,
217	!! limit_W and limit_L (0-1, unitless)
218	REAL(r_std), DIMENSION(npts) :: t_nitrogen !! Preliminairy soil temperature stress
219	!! used as a proxy for nitrogen stress (K)
220	REAL(r_std), DIMENSION(npts) :: h_nitrogen !! Preliminairy soil humidity stress used
221	!! as a proxy for nitrogen stress
222	!! (unitless)
223	REAL(r_std), DIMENSION(npts) :: rpc !! Scaling factor for integrating vertical
224	!! soil profiles (unitless)
225	REAL(r_std), DIMENSION(npts) :: LtoLSR !! Ratio between leaf-allocation and
226	!! (leaf+sapwood+root)-allocation
227	!! (0-1, unitless)
228	REAL(r_std), DIMENSION(npts) :: StoLSR !! Ratio between sapwood-allocation and
229	!! (leaf+sapwood+root)-allocation
230	!! (0-1, unitless)
231	REAL(r_std), DIMENSION(npts) :: RtoLSR !! Ratio between root-allocation and
232	!! (leaf+sapwood+root)-allocation
233	!! (0-1, unitless)
234	REAL(r_std), DIMENSION(npts) :: carb_rescale !! Rescaling factor for allocation factors
235	!! if carbon is allocated to carbohydrate
236	!! reserve (0-1, unitless)
237	REAL(r_std), DIMENSION(npts) :: use_reserve !! Mass of carbohydrate reserve used to
238	!! support growth
239	!! @tex $(gC m^{-2})$ @endtex
240	REAL(r_std), DIMENSION(npts) :: transloc_leaf !! Fraction of carbohydrate reserve used
241	!! (::use_reserve) to support leaf growth
242	!! @tex $(gC m^{-2})$ @endtex
243	REAL(r_std), DIMENSION(npts) :: leaf_mass_young !! Leaf biomass in youngest leaf age class
244	!! @tex $(gC m^{-2})$ @endtex
245	REAL(r_std), DIMENSION(npts,nvm) :: lm_old !! Variable to store leaf biomass from
246	!! previous time step
247	!! @tex $(gC m^{-2})$ @endtex
248	REAL(r_std) :: reserve_time !! Maximum number of days during which
249	!! carbohydrate reserve may be used (days)
250	REAL(r_std), DIMENSION(npts,nvm) :: lai_around !! lai on natural part of the grid cell, or
251	!! of agricultural PFTs
252	!! @tex $(m^2 m^{-2})$ @endtex
253	REAL(r_std), DIMENSION(npts,nvm) :: veget_max_nat !! Vegetation cover of natural PFTs on the
254	!! grid cell (agriculture masked)
255	!! (0-1, unitless)
256	REAL(r_std), DIMENSION(npts) :: natveg_tot !! Total natural vegetation cover on
257	!! natural part of the grid cell
258	!! (0-1, unitless)
259	REAL(r_std), DIMENSION(npts) :: lai_nat !! Average LAI on natural part of the grid
260	!! cell @tex $(m^2 m^{-2})$ @endtex
261	REAL(r_std), DIMENSION(npts) :: zdiff_min !! [DISPENSABLE] intermediate array for
262	!! looking for minimum
263	REAL(r_std), DIMENSION(npts) :: alloc_sap_above !! Prescribed fraction of sapwood
264	!! allocation to above ground sapwood
265	!! (0-1, unitless)
266	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: z_soil !! Variable to store depth of the different
267	!! soil layers (m)
268	!$OMP THREADPRIVATE(z_soil)
269	INTEGER(i_std) :: i,j,l,m !! Indices (unitless)
270	!gmjc
271	! rescaling factor for LtoLSR of grass,PFT=10
272	REAL(r_std), DIMENSION(npts) :: alloc_leaf
273	!end gmjc
274	INTEGER(i_std) :: ier !! Error handling
275
276	!_ ================================================================================================================================
277
278	IF (printlev>=3) WRITE(numout,*) 'Entering alloc'
279
280	!! 1. Initialize
281
282	!! 1.1 First call only
283	IF ( firstcall_alloc ) THEN
284
285	!
286	! 1.1.0 Initialization
287	!
288	L0(2:nvm) = un - R0(2:nvm) - S0(2:nvm)
289	IF ((MINVAL(L0(2:nvm)) .LT. zero) .OR. (MAXVAL(S0(2:nvm)) .EQ. un)) THEN
290	CALL ipslerr_p (3,'in module stomate_alloc', &
291	& 'Something wrong happened', &
292	& 'L0 negative or division by zero if S0 = 1', &
293	& '(Check your parameters.)')
294	ENDIF
295
296
297	!! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl)
298	! previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90
299	ALLOCATE(z_soil(0:nbdl), stat=ier)
300	IF ( ier /= 0 ) CALL ipslerr_p(3,'stomate_alloc','Pb in allocate of z_soil','','')
301	z_soil(0) = zero
302	z_soil(1:nbdl) = diaglev(1:nbdl)
303
304	!! 1.1.2 Print flags and parameter settings
305	WRITE(numout,*) 'alloc:'
306	WRITE(numout,'(a,$)') ' > We'
307	IF ( .NOT. ok_minres ) WRITE(numout,'(a,$)') ' do NOT'
308	WRITE(numout,*) 'try to reach a minumum reservoir when severely stressed.'
309	WRITE(numout,*) ' > Time delay (days) to build leaf mass (::tau_leafinit): ', &
310	tau_leafinit(:)
311	WRITE(numout,*) ' > Curvature of root mass with increasing soil depth (::z_nitrogen): ', &
312	z_nitrogen
313	WRITE(numout,*) ' > Sap allocation above the ground / total sap allocation (0-1, unitless): '
314	WRITE(numout,*) ' grasses (::alloc_sap_above_grass) :', alloc_sap_above_grass
315	WRITE(numout,*) ' > Default root alloc fraction (1; ::R0): ', R0(:)
316	WRITE(numout,*) ' > Default sapwood alloc fraction (1; ::S0): ', S0(:)
317	WRITE(numout,*) ' > Default fruit allocation (1, ::f_fruit): ', f_fruit
318	WRITE(numout,*) ' > Minimum (min_LtoLSR)/maximum (::max_LtoLSR)leaf alloc fraction (0-1, unitless): ',&
319	min_LtoLSR,max_LtoLSR
320	WRITE(numout,*) ' > Maximum time (days) the carbon reserve can be used:'
321	WRITE(numout,*) ' trees (reserve_time_tree):',reserve_time_tree
322	WRITE(numout,*) ' grasses (reserve_time_grass):',reserve_time_grass
323
324	firstcall_alloc = .FALSE.
325
326	ENDIF
327
328
329	!! 1.2 Every call
330	!! 1.2.1 Reset output variable (::f_alloc)
331	f_alloc(:,:,:) = zero
332	f_alloc(:,:,icarbres) = un
333
334
335	!! 1.2.2 Proxy for soil nitrogen stress
336	! Nitrogen availability and thus N-stress can not be calculated by the model. Water and
337	! temperature stress are used as proxy under the assumption that microbial activity is
338	! determined by soil temperature and water availability. In turn, microbial activity is
339	! assumed to be an indicator for nitrogen mineralisation and thus its availability.
340
341	!! 1.2.2.1 Convolution of nitrogen stress with root profile
342	! Here we calculate preliminary soil temperature and soil humidity stresses that will be used
343	! as proxies for nitrogen stress. Their calculation follows the nitrogen-uptake capacity of roots.
344	! The capacity of roots to take up nitrogen is assumed to decrease exponentially with
345	! increasing soil depth. The curvature of the exponential function describing the
346	! nitrogen-uptake capacity of roots (= root mass * uptake capacity) is given by
347	! ::z_nitrogen. Strictly speaking its unit is meters (m). Despite its units this parameter
348	! has no physical meaning.
349	! Because the roots are described by an exponential function but the soil depth is limited to
350	! ::z_soil(nbdl), the root profile is truncated at ::z_soil(nbdl). For numerical reasons,
351	! the total capacity of the soil profile for nitrogen uptake should be 1. To this aim a scaling
352	! factor (::rpc) is calculated as follows:\n
353	! \latexonly
354	! \input{alloc2.tex}
355	! \endlatexonly
356	! Then temperature (::t_nitrogen) and humidity (::h_nitrogen) proxies for nitrogen stress are
357	! calculated using mean weighted (weighted by nitrogen uptake capacity) soil temperature (::tsoil_month)
358	! or soil moisture (::soil_hum_month) (calculated in stomate_season.f90).
359	! \latexonly
360	! \input{alloc3.tex}
361	! \endlatexonly
362	! \latexonly
363	! \input{alloc4.tex}
364	! \endlatexonly
365	! \n
366
367	! Scaling factor for integration
368	rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_nitrogen ) )
369
370	! Integrate over # soil layers
371	t_nitrogen(:) = zero
372
373	DO l = 1, nbdl ! Loop over # soil layers
374
375	t_nitrogen(:) = &
376	t_nitrogen(:) + tsoil_month(:,l) * rpc(:) * &
377	( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
378
379	ENDDO ! Loop over # soil layers
380
381
382	!!$ !! 1.2.2.2 Convolution for soil moisture
383	!!$ ! Scaling factor for integration
384	!!$ rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
385
386	! Integrate over # soil layers
387	h_nitrogen(:) = zero
388
389	DO l = 1, nbdl ! Loop over # soil layers
390
391	h_nitrogen(:) = &
392	h_nitrogen(:) + soilhum_month(:,l) * rpc(:) * &
393	( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
394
395	ENDDO ! Loop over # soil layers
396
397
398	!! 1.2.3 Separate between natural and agrigultural LAI
399	! The model distinguishes different natural PFTs but does not contain information
400	! on whether these PFTs are spatially separated or mixed. In line with the DGVM the
401	! models treats the natural PFT's as mixed. Therefore, the average LAI over the
402	! natural PFTs is calculated to estimate light stress. Agricultural PFTs are spatially
403	! separated.
404	natveg_tot(:) = zero
405	lai_nat(:) = zero
406
407	DO j = 2, nvm ! Loop over # PFTs
408
409	IF ( natural(j) .AND. .NOT. pasture(j)) THEN
410	! Mask agricultural vegetation
411	veget_max_nat(:,j) = veget_max(:,j)
412	ELSE
413	! Mask natural vegetation
414	veget_max_nat(:,j) = zero
415	ENDIF
416
417	! Sum up fraction of natural space covered by vegetation
418	natveg_tot(:) = natveg_tot(:) + veget_max_nat(:,j)
419
420	! Sum up lai
421	lai_nat(:) = lai_nat(:) + veget_max_nat(:,j) * lai(:,j)
422
423	ENDDO ! Loop over # PFTs
424
425	DO j = 2, nvm ! Loop over # PFTs
426
427	IF ( natural(j) .AND. .NOT. pasture(j)) THEN
428
429	! Use the mean LAI over all natural PFTs when estimating light stress
430	! on a specific natural PFT
431	lai_around(:,j) = lai_nat(:)
432	ELSE
433
434	! Use the actual LAI (specific for that PFT) when estimating light
435	! stress on a specific agricultural PFT
436	lai_around(:,j) = lai(:,j)
437	ENDIF
438
439	ENDDO ! Loop over # PFTs
440
441
442	!! 1.2.4 Calculate LAI threshold below which carbohydrate reserve is used.
443	! Lai_max is a PFT-dependent parameter specified in stomate_constants.f90
444	!JCMODIF
445	lai_happy(:) = lai_max(:) * lai_max_to_happy(:)
446	! DO j = 2, nvm
447	! lai_happy(:,j) = lai_max(j) * lai_max_to_happy(j)
448	! ENDDO
449	!ENDJCMODIF
450	!! 2. Use carbohydrate reserve to support growth and update leaf age
451
452	! Save old leaf mass, biomass got last updated in stomate_phenology.f90
453	lm_old(:,:) = biomass(:,:,ileaf,icarbon)
454
455	DO j = 2, nvm ! Loop over # PFTs
456
457	!! 2.1 Calculate demand for carbohydrate reserve to support leaf and root growth.
458	! Maximum time (days) since start of the growing season during which carbohydrate
459	! may be used
460	IF ( is_tree(j) ) THEN
461	reserve_time = reserve_time_tree
462	ELSE
463	reserve_time = reserve_time_grass
464	ENDIF
465
466	IF ( ok_LAIdev(j) ) THEN
467	! For crops, at the moment, we do not relocate C from leaf to root
468	! & carbres, but future processes should be added during maturity
469	! stage, transloc_leaf represents the overall allocated biomass for
470	! leaf
471	! This is likely a bug that lead to decrease of leaf age for
472	! crops. Xuhui
473	DO i = 1,npts
474
475	IF ( ( biomass(i,j,ileaf,icarbon) .GT. zero ) .AND. &
476	( .NOT. senescence(i,j) ) .AND. &
477	( lai(i,j) .LT. lai_happy(j) ) .AND. &
478	( when_growthinit(i,j) .LT. reserve_time ) ) THEN
479
480	!transloc_leaf(i) = deltai(i,j)/ssla(i,j)*10000.
481	transloc_leaf(i) = 0.0 !deltai(i,j)/ssla(i,j)*10000.
482	! biomass(i,j,ileaf) = biomass(i,j,ileaf)
483	! biomass(i,j,iroot) = biomass(i,j,iroot)
484	! biomass(i,j,icarbres) = biomass(i,j,icarbres)
485	ENDIF
486	ENDDO
487	ELSE
488
489	! Growth is only supported by the use of carbohydrate reserves if the following
490	! conditions are statisfied:\n
491	! - PFT is not senescent;\n
492	! - LAI must be low (i.e. below ::lai_happy) and\n
493	! - Day of year of the simulation is in the beginning of the growing season.
494	IF ( (printlev>=5) .AND. (j .EQ. 10) ) THEN
495	WRITE(numout,*) 'xuhui: stomate_alloc debug for PFT 10'
496	WRITE(numout,*) 'when_growthinit(:,j),', when_growthinit(:,j)
497	WRITE(numout,*) 'lai(:,j),', lai(:,j)
498	WRITE(numout,*) 'lai_happy(j),', lai_happy(j)
499	ENDIF
500	WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
501	( .NOT. senescence(:,j) ) .AND. &
502	( lai(:,j) .LT. lai_happy(j) ) .AND. &
503	( when_growthinit(:,j) .LT. reserve_time ) )
504
505	! Determine the mass from the carbohydrate reserve that can be used @tex $(gC m^{-2})$ @endtex.
506	! Satisfy the demand or use everything that is available
507	! (i.e. ::biomass(:,j,icarbres)). Distribute the demand evenly over the time
508	! required (::tau_leafinit) to develop a minimal canopy from reserves (::lai_happy).
509	use_reserve(:) = &
510	MIN( biomass(:,j,icarbres,icarbon), &
511	!JCMODIF
512	! deux * dt/tau_leafinit(j) * lai_happy(j)/ sla(j) )
513	deux * dt/tau_leafinit(j) * lai_happy(j)/ sla_calc(:,j) )
514	!ENDJCMODIF
515	! Distribute the reserve over leaves and fine roots.
516	! The part of the reserve going to the leaves is the ratio of default leaf allocation to default root and leaf allocation.
517	! The remaining of the reserve is alocated to the roots.
518	transloc_leaf(:) = L0(j)/(L0(j)+R0(j)) * use_reserve(:)
519	biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) + transloc_leaf(:)
520	biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) + ( use_reserve(:) - transloc_leaf(:) )
521
522	! Adjust the carbohydrate reserve mass by accounting for the reserves allocated to leaves and roots during
523	! this time step
524	biomass(:,j,icarbres,icarbon) = biomass(:,j,icarbres,icarbon) - use_reserve(:)
525
526	ELSEWHERE
527
528	transloc_leaf(:) = zero
529
530	ENDWHERE
531	!gmjc modify leaf_age and leaf_frac when_growthinit
532	IF (is_grassland_manag(j)) THEN
533	WHERE ( when_growthinit(:,j) .EQ. 0)
534	leaf_age(:,j,2)=10
535	leaf_age(:,j,3)=20
536	leaf_age(:,j,4)=30
537	ENDWHERE
538	WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. 0.0 ) .AND. &
539	( when_growthinit_cut(:,j) .LT. reserve_time_cut ) .AND. &
540	! ( lai(:,j) .LT. lai_max_calc(:,j)*0.5 ) )!1.25
541	( lai(:,j) .LT. lai_happy(j) ) )
542	! ( turnover_daily(:,j,ileaf) .LT. turnover_max_cut) )
543	! determine mass to put on
544	use_reserve(:) = &
545	MIN( biomass(:,j,icarbres,icarbon), &
546	! 2._r_std * dt/tau_leafinit_cut *
547	! lai_happy_cut / sla(j) )
548	2._r_std * dt/tau_leafinit_cut * lai_happy_cut /sla_calc(:,j) )
549	! grow leaves and fine roots
550
551	transloc_leaf(:) = use_reserve(:)
552
553	biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) + transloc_leaf(:)
554	biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) + ( use_reserve(:) - transloc_leaf(:) )
555
556	! decrease reserve mass
557
558	biomass(:,j,icarbres,icarbon) = biomass(:,j,icarbres,icarbon) - use_reserve(:)
559
560	ENDWHERE
561	END IF
562
563	!end gmjc
564	ENDIF
565	!! 2.2 Update leaf age
566	!! 2.2.1 Decrease leaf age in youngest class
567	! Adjust the mass of the youngest leaves by the newly grown leaves
568	leaf_mass_young(:) = leaf_frac(:,j,1) * lm_old(:,j) + transloc_leaf(:)
569
570	WHERE ( ( transloc_leaf(:) .GT. min_stomate ) .AND. ( leaf_mass_young(:) .GT. min_stomate ) )
571
572	! Adjust leaf age by the ratio of leaf_mass_young (t-1)/leaf_mass_young (t)
573	leaf_age(:,j,1) = MAX( zero, leaf_age(:,j,1) * ( leaf_mass_young(:) - transloc_leaf(:) ) / &
574	leaf_mass_young(:) )
575
576	ENDWHERE
577
578	!! 2.2.2 Update leaf mass fraction for the different age classes
579	! Mass fraction in the youngest age class is calculated as the ratio between
580	! the new mass in the youngest class and the total leaf biomass
581	! (inc. the new leaves)
582	WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
583
584	leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
585
586	ENDWHERE
587
588
589	! Mass fraction in the other classes is calculated as the ratio bewteen
590	! the current mass in that age and the total leaf biomass
591	! (inc. the new leaves)\n
592	DO m = 2, nleafages ! Loop over # leaf age classes
593
594	WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
595
596	leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
597
598	ENDWHERE
599
600	ENDDO ! Loop over # leaf age classes
601
602	ENDDO ! loop over # PFTs
603
604	!! 3. Calculate allocatable fractions of biomass production (NPP)
605
606	! Calculate fractions of biomass production (NPP) to be allocated to the different
607	! biomass components.\n
608	! The fractions of NPP allocated (0-1, unitless) to the different compartments depend on the
609	! availability of light, water, and nitrogen.
610	DO j = 2, nvm ! Loop over # PFTs
611	IF (.NOT. ok_LAIdev(j) ) THEN ! bypass this part for crops
612
613	! Reset values
614	RtoLSR(:) = zero
615	LtoLSR(:) = zero
616	StoLSR(:) = zero
617	!gmjc
618	alloc_leaf(:)=1.0
619	!end gmjc
620	! For trees, partitioning between above and belowground sapwood biomass is a function
621	! of age. An older tree gets more allocation to the aboveground sapwoood than a younger tree.
622	! For the other PFTs it is prescribed.
623	! ::alloc_min, ::alloc_max and ::demi_alloc are specified in stomate_constants.f90
624	IF ( is_tree(j) ) THEN
625
626	alloc_sap_above(:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(un-EXP(-age(:,j)/demi_alloc(j)))
627
628	ELSE
629
630	alloc_sap_above(:) = alloc_sap_above_grass
631	!!gmjc balance the above/below ground allocation to avoid strong unbalance
632	! WHERE ( SUM(biomass(:,j,(/isapabove,iheartabove,ileaf/),icarbon))/ &
633	! SUM(biomass(:,j,(/isapabove,iheartabove,isapbelow,iheartbelow,ileaf,iroot/),icarbon)) > &
634	! 0.8 * alloc_sap_above(:) )
635	!! alloc_sap_above (:) = 0.05
636	! alloc_leaf(:) = 0.5
637	! ELSEWHERE (SUM(biomass(:,j,(/isapabove,iheartabove,ileaf/),icarbon))/ &
638	! SUM(biomass(:,j,(/isapabove,iheartabove,isapbelow,iheartbelow,ileaf,iroot/),icarbon)) < &
639	! 0.2 * alloc_sap_above(:) )
640	!! alloc_sap_above (:) = 0.95
641	! alloc_leaf(:) = 2
642	! ENDWHERE
643	! DO i=1,npts
644	! alloc_sap_above(i)=min(alloc_sap_above(i),1.)
645	! alloc_sap_above(i)=max(alloc_sap_above(i),0.)
646	! ENDDO
647	!!end gmjc
648	ENDIF
649
650
651	!! 3.1 Calculate light stress, water stress and proxy for nitrogen stress.\n
652	! For the limiting factors a low value indicates a strong limitation
653	! IF (j.EQ.10) WRITE(numout,*) 'zd toLSR 1 ','RtoLSR(1)',RtoLSR(1),'limit_WorN(1)',limit_WorN(1),'lai_around(1,10)',lai_around(1,10),'moiavail_week(1,10)',moiavail_week(1,10),'h_nitrogen(1)',h_nitrogen(1),'t_nitrogen(1)',t_nitrogen(1),'tsoil_month(1,:)',tsoil_month(1,:),'rpc(1)',rpc(1),'soilhum_month(1,:)',soilhum_month(1,:)
654	WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
655
656	!! 3.1.1 Light stress
657	! Light stress is a function of the mean lai on the natural part of the grid box
658	! and of the PFT-specific LAI for agricultural crops. In line with the DGVM, natural
659	! PFTs in the same gridbox are treated as if they were spatially mixed whereas
660	! agricultural PFTs are considered to be spatially separated.
661	! The calculation of the lights stress depends on the extinction coefficient (set to 0.5)
662	! and of a mean LAI.
663	WHERE( lai_around(:,j) < max_possible_lai )
664
665	limit_L(:) = MAX( 0.1_r_std, EXP( -ext_coeff(j) * lai_around(:,j) ) )
666
667	ELSEWHERE
668
669	limit_L(:) = 0.1_r_std
670
671	ENDWHERE
672
673	!! 3.1.2 Water stress
674	! Water stress is calculated as the weekly moisture availability.
675	! Weekly moisture availability is calculated in stomate_season.f90.
676	limit_W(:) = MAX( 0.1_r_std, MIN( un, moiavail_week(:,j) ) )
677
678
679	!! 3.1.3 Proxy for nitrogen stress
680	! The proxy for nitrogen stress depends on monthly soil water availability
681	! (::soilhum_month) and monthly soil temperature (::tsoil_month). See section
682	! 1.2.2 for details on how ::t_nitrogen and ::h_nitrogen were calculated.\n
683	! Currently nitrogen-stress is calculated for both natural and agricultural PFTs.
684	! Due to intense fertilization of agricultural PFTs this is a strong
685	! assumption for several agricultural regions in the world (US, Europe, India, ...)
686	! Water stress on nitrogen mineralisation
687	limit_N_hum(:) = MAX( undemi, MIN( un, h_nitrogen(:) ) )
688
689	! Temperature stress on nitrogen mineralisation using a Q10 decomposition model
690	! where Q10 was set to 2
691	limit_N_temp(:) = 2.**((t_nitrogen(:) - ZeroCelsius - Nlim_tref )/Nlim_Q10)
692	limit_N_temp(:) = MAX( 0.1_r_std, MIN( un, limit_N_temp(:) ) )
693
694	! Combine water and temperature factors to get total nitrogen stress
695	limit_N(:) = MAX( 0.1_r_std, MIN( un, limit_N_hum(:) * limit_N_temp(:) ) )
696
697	! Take the most limiting factor among soil water and nitrogen
698	limit_WorN(:) = MIN( limit_W(:), limit_N(:) )
699
700	! Take the most limiting factor among aboveground (i.e. light) and belowground
701	! (i.e. water & nitrogen) limitations
702	limit(:) = MIN( limit_WorN(:), limit_L(:) )
703
704	!! 3.2 Calculate ratio between allocation to leaves, sapwood and roots
705	! Partitioning between belowground and aboveground biomass components is assumed
706	! to be proportional to the ratio of belowground and aboveground stresses.\n
707	! \latexonly
708	! \input{alloc1.tex}
709	! \endlatexonly
710	! Root allocation is the default root allocation corrected by a normalized ratio of aboveground stress to total stress.
711	! The minimum root allocation is 0.15.
712	RtoLSR(:) = &
713	MAX( .15_r_std, &
714	R0(j) * trois * limit_L(:) / ( limit_L(:) + deux * limit_WorN(:) ) )
715
716	! Sapwood allocation is the default sapwood allocation corrected by a normalized ratio of belowground stress to total stress.
717	StoLSR(:) = S0(j) * 3. * limit_WorN(:) / ( 2._r_std * limit_L(:) + limit_WorN(:) )
718
719	! Leaf allocation is calculated as the remaining allocation fraction
720	! The range of variation of leaf allocation is constrained by ::min_LtoLSR and ::max_LtoLSR.
721	!JCMODIF
722	LtoLSR(:) = un - RtoLSR(:) - StoLSR(:)
723	LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
724	! WHERE ( alloc_leaf(:) .NE. 1.0 )
725	! LtoLSR(:) = alloc_leaf(:) * ( 1. - RtoLSR(:) - StoLSR(:) )
726	! WHERE ( alloc_leaf(:) .EQ. 2.0 )
727	! LtoLSR(:) = MAX( min_LtoLSR, MIN( 1. , LtoLSR(:) ) )
728	! ELSEWHERE
729	! LtoLSR(:) = MIN( max_LtoLSR, MAX( 0. , LtoLSR(:) ) )
730	! ENDWHERE
731	! StoLSR(:) = ( 1 - LtoLSR(:) ) * StoLSR(:) / ( RtoLSR(:) + StoLSR(:) )
732	! ELSEWHERE
733	! LtoLSR(:) = un - RtoLSR(:) - StoLSR(:)
734	! LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
735	! ENDWHERE
736	!ENDJCMODIF
737
738	! Roots allocation is recalculated as the residual carbon after leaf allocation has been calculated.
739	RtoLSR(:) = un - LtoLSR(:) - StoLSR(:)
740
741	ENDWHERE
742	! IF (j.EQ.10) WRITE(numout,*) 'zd toLSR 2 ','RtoLSR(1)',RtoLSR(1),'limit_L(1)',limit_L(1)
743
744	! Check whether allocation needs to be adjusted. If LAI exceeds maximum LAI
745	! (::lai_max), no addition carbon should be allocated to leaf biomass. Allocation is
746	! then partioned between root and sapwood biomass.
747	WHERE ( (biomass(:,j,ileaf,icarbon) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
748
749	StoLSR(:) = StoLSR(:) + LtoLSR(:)
750	LtoLSR(:) = zero
751
752	ENDWHERE
753
754	!! 3.3 Calculate the allocation fractions.
755	! The allocation fractions (::f_alloc) are an output variable (0-1, unitless). f_alloc
756	! has three dimensions (npts,nvm,nparts). Where ::npts is the number of grid cells, ::nvm is the
757	! number of PFTs and ::nparts the number of biomass components. Currently six biomass compartments
758	! are distinguished: (1) Carbon reserves, (2) Aboveground sapwood, (3) Belowground
759	! sapwood, (4) Roots, (5) fruits/seeds and (6) Leaves.@tex $(gC m^{-2})$ @endtex \n
760	! IF (j.EQ.10) WRITE(numout,*) 'zd f_alloc 1 ','f_alloc(1,10,ileaf)',f_alloc(1,10,ileaf),'LtoLSR(1)',LtoLSR(1),'RtoLSR(1)',RtoLSR(1),'StoLSR(1)',StoLSR(1)
761	DO i = 1, npts ! Loop over grid cells
762
763	IF ( biomass(i,j,ileaf,icarbon) .GT. min_stomate ) THEN
764
765	IF ( senescence(i,j) ) THEN
766
767	!! 3.3.1 Allocate all C to carbohydrate reserve
768	! If the PFT is senescent allocate all C to carbohydrate reserve,
769	! then the allocation fraction to reserves is 1.
770	f_alloc(i,j,icarbres) = un
771
772	ELSE
773
774	!! 3.3.2 Allocation during the growing season
775	f_alloc(i,j,ifruit) = f_fruit
776
777
778	! Allocation to the carbohydrate reserve is proportional to leaf and root
779	! allocation. If carbon is allocated to the carbohydrate reserve, rescaling
780	! of allocation factors is required to ensure carbon mass preservation.\n
781	! Carbon is allocated to the carbohydrate reserve when the pool size of the
782	! reserve is less than the carbon needed to grow a canopy twice the size of
783	! the maximum LAI (::lai_max). Twice the size was used as a threshold because
784	! the reserves needs to be sufficiently to grow a canopy and roots. In case
785	! the carbohydrate pool is full, there is no need to rescale the other
786	! allocation factors.
787	! If there is no rescaling of the allocation factors (carbres=1, no carbon put
788	! to reserve), then fraction remaining after fruit allocation (1-fruit_alloc)
789	! is distributed between leaf, root and sap (sap carbon also distributed between
790	! sap_above and sap_below with factor alloc_sap_above).
791	! If carbon is allocated to the carbohydrate reserve, all these factors are
792	! rescaled through carb_rescale, and an allocation fraction for carbohydrate pool
793	! appears. carb_rescale depends on the parameter (::ecureuil).
794	! (::ecureuil) is the fraction of primary leaf and root allocation put into
795	! reserve, it is specified in stomate_constants.f90 and is either 0 or 1.
796	!JCMODIF
797	! IF ( ( biomass(i,j,icarbres)sla(j) ) .LT. 2lai_max(j) ) THEN
798	IF ( ( biomass(i,j,icarbres,icarbon)sla_calc(i,j) ) .LT. 2lai_max(j) ) THEN
799	!ENDJCMODIF
800	carb_rescale(i) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
801	ELSE
802	carb_rescale(i) = un
803	ENDIF
804
805	f_alloc(i,j,ileaf) = LtoLSR(i) * ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
806	f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
807	( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
808	f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * &
809	( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
810	f_alloc(i,j,iroot) = RtoLSR(i) * (un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
811	f_alloc(i,j,icarbres) = ( un - carb_rescale(i) ) * ( un - f_alloc(i,j,ifruit) )
812	IF ( (printlev>=5) .AND. (j .EQ. 10) ) THEN
813	WRITE(numout,*) 'f_alloc(i,10,ileaf)', f_alloc(i,10,ileaf)
814	ENDIF
815
816	ENDIF ! Is senescent?
817
818	ENDIF ! There are leaves
819
820	ENDDO ! Loop over # pixels - domain size
821	! IF (j.EQ.10) WRITE(numout,*) 'zd f_alloc 2 ','f_alloc(1,10,ileaf)',f_alloc(1,10,ileaf)
822	ENDIF ! Is crop?
823
824	ENDDO ! loop over # PFTs
825
826	IF (printlev>=3) WRITE(numout,*) 'Leaving alloc'
827
828	END SUBROUTINE alloc
829
830	END MODULE stomate_alloc

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd_2018_MICT-LEAK/src_stomate/stomate_alloc.f90 @ 6145

Download in other formats: