source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.backup @ 6940

Last change on this file since 6940 was 6940, checked in by jinfeng.chang, 4 years ago

add missing files for ORCHIDEE-GMv3.2
File size: 13.9 KB
Line 
1! This subrutine is addressing the Carbon allocation for crops in combination with STICS
2! Author: Xiuchen Wu
3! Date: 1/08/2013
4
5module crop_alloc
6
7! use modules
8
9USE ioipsl
10USE pft_parameters
11USE constantes
12USE netcdf
13
14IMPLICIT NONE
15
16CONTAINS
17
18subroutine crop_bmalloc(in_cycle,         &
19                      deltai,           &
20                      dltaisen,         &
21                      ssla,             &
22                      pgrain,           &
23                      deltgrain,          &
24                      reprac,           &
25                      nger,             &
26                      nlev,             &
27                      ndrp,             &
28                      nlax,             &    ! input
29                      nrec,             &
30                      bm_alloc_tot,     &    ! input
31                      biomass,          &
32                      c_reserve,        &    ! out
33                      c_leafb,          &    ! out
34                      bm_alloc,         &    ! inout
35                      P_densitesem,     &
36                      P_pgrainmaxi,     &
37                      P_tigefeuil,     &
38                      P_slamax,        &
39                      slai)               ! parameter
40
41   !USE ioipsl
42   !USE pft_parameters
43   !USE constantes
44   
45   ! Declaration part
46   
47   ! 0.0 INPUT PART
48   LOGICAL, INTENT(IN)                 :: in_cycle           
49   REAL(r_std),  INTENT(IN)            :: deltai         ! lai increment  // unit in m2 m-2
50   REAL(r_std),  INTENT(IN)            :: dltaisen       ! lai senescence  // unit in m2 m-2
51   REAL(r_std),  INTENT(IN)            :: ssla           ! sla from STICS // unit in g cm -2
52   REAL(r_std),  INTENT(IN)            :: pgrain         ! weight per grain (dry matter, but not carbon)  // g
53   REAL(r_std),  INTENT(IN)            :: deltgrain        ! grain yield increment (dry matter but not carbon)  // unit g c / m2
54   REAL(r_std),  INTENT(IN)            :: reprac
55   INTEGER(i_std),  INTENT(IN)            :: nger
56   INTEGER(i_std),  INTENT(IN)            :: nlev
57   INTEGER(i_std),  INTENT(IN)            :: ndrp
58   INTEGER(i_std), INTENT(IN)            :: nlax
59   INTEGER(i_std), INTENT(IN)            :: nrec
60   REAL(r_std), INTENT(IN)             :: bm_alloc_tot   ! unit in g m-2
61   REAL(r_std),  INTENT(IN)            :: P_densitesem
62   REAL(r_std),  INTENT(IN)            :: P_pgrainmaxi
63   REAL(r_std),  INTENT(IN)            :: P_tigefeuil
64   REAL(r_std),  INTENT(IN)            :: P_slamax
65
66   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)             :: biomass   ! unit in g m-2
67   
68   ! 1.0 INOUT PART
69
70   REAL(r_std), INTENT(INOUT)            ::c_reserve  ! crop reserve
71   REAL(r_std), INTENT(INOUT)            ::c_leafb ! crop leaf biomass derived from STICS
72   REAL(r_std), INTENT(INOUT)            ::slai ! stics simulated lai
73
74   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)            ::bm_alloc ! crop leaf biomass derived from STICS
75   
76   ! 2.0 local
77   REAL             ::  grainrem   ! daily grain minus reservoir, the remaining carbon
78   REAL             ::  deltmagrain   ! daily grain/ (unit in carbon)
79   INTEGER          :: ipart
80
81
82    ! Part one: conversion from biomass(dry matter) to carbon
83    deltmagrain = deltgrain*0.48
84
85    ! STRATEGY:
86    ! We keep the leaf biomass, grain and reprac from STICS
87    ! Total available biomass for allocation is dltams and cropreserv.
88
89    !IF (bavard .GE. 3) WRITE(numout,*) 'Entering crop alloc'
90   
91    ! 1. whether or not necessary to enter into this process
92   
93    if (.not. in_cycle) return   ! if not yet into the crop cycle or finish the cycle
94
95    ! 1. initialize the bm_alloc (biomass allocation)
96    !
97
98    bm_alloc(:) = 0.      ! 8 parts
99       
100    ! 2.  leaf biomass from STICS
101    ! in this subroutine, we USED the Leaf biomass and GRAIN yield, the leaf biomass and grain production is adjusted accoring to different stages (in detail see leaf and grain processes)
102
103    c_leafb = 0.
104    if (in_cycle) then
105       if (deltai > 0.) then  ! just for leaf growth period
106           c_leafb = deltai/ssla*10000.0*0.48
107       else
108           c_leafb = 0.
109       endif
110    else
111       c_leafb = 0.
112    endif
113 
114   
115    ! 3. reinitialization of leaf and fruit biomass
116 
117    bm_alloc(ileaf) = c_leafb
118    bm_alloc(ifruit)= deltmagrain
119    !bm_alloc(icarbres) = c_reserve
120   
121 
122    ! 4.  real allocation for each grid and each pft
123
124    ! STRATEGY:
125    ! 1. carbon allocation priority is different for different parts;
126    ! 2. even for the same pool, the priority is changing along with time (stage revolution)
127   
128    ! 3.1 FOR STAGE [nger, nlev]
129
130    ! the c_reserve starts to decreasing because the root growth
131    ! and we allocate all carbon into root
132
133    if ((nger .gt. 0) .and. (nlev .eq. 0)) then ! germination occured but did not emerge, during this stage only root and reserve pools
134       if ( biomass(icarbres) > 0.) then  ! adjust the reserve dynamics
135          ! addressing the c_reserve dynamics
136          bm_alloc(iroot) = biomass(icarbres)*reprac
137          bm_alloc(icarbres) = 0. - biomass(icarbres)*reprac
138       else
139          !c_reserve = 0.
140          bm_alloc(icarbres) = 0.
141          bm_alloc(iroot) = 0.
142       endif
143    endif
144   
145    ! 3.2 FOR STAGE [NLEV, NDRP]
146    if ((nlev .gt. 0) .and. (ndrp .eq. 0)) then
147    ! emergence and photosynthese, whereas grain is not filling
148    ! in this stage, we keep the leaf and grain biomass
149    ! root with the higher priority
150
151       ! in this stage, the allocation of leaf and root is with higher priority
152       bm_alloc(ileaf) = c_leafb
153       bm_alloc(iroot) = reprac*bm_alloc_tot   ! root biomass
154       !bm_alloc(icarbres) = c_reserve       
155 
156       if (c_leafb >= bm_alloc_tot) then
157
158          if (biomass(icarbres) >= (c_leafb - bm_alloc_tot )) then ! enough for leaf and root
159             bm_alloc(ileaf) = c_leafb
160             !c_reserve = c_reserve - (c_leafb - bm_alloc_tot)   ! leaf with the highest priority         
161             bm_alloc(icarbres) = 0. - (c_leafb - bm_alloc_tot)
162          else
163             bm_alloc(ileaf) = bm_alloc_tot + biomass(icarbres)
164             !c_reserve = 0.
165             bm_alloc(icarbres) = 0. - biomass(icarbres)
166          end if ! keep the leaf biomass
167         
168          ! judge the remaining c_reserve
169!          if (biomass(icarbres) > reprac*bm_alloc_tot) then
170!!!!!! xuhui: it forgot to consider the previously leaf removed carbon from the reserve
171          if ( (biomass(icarbres)+bm_alloc(icarbres)) > reprac*bm_alloc_tot) then
172             bm_alloc(iroot) = reprac*bm_alloc_tot
173             !c_reserve = c_reserve - bm_alloc(iroot)
174             ! bm_alloc(icarbres) = 0. - reprac*bm_alloc_tot             
175!!!!!! xuhui: again, need to include the leaf removal from the carbon reserve
176             bm_alloc(icarbres) = bm_alloc(icarbres) - reprac*bm_alloc_tot             
177
178          else 
179             !bm_alloc(iroot) = biomass(icarbres)
180!!!!!! xuhui: again, need to include the leaf removal already
181             bm_alloc(iroot) = biomass(icarbres) + bm_alloc(icarbres)
182             !c_reserve = 0.
183             bm_alloc(icarbres) = 0. - biomass(icarbres)
184          endif
185
186       else if ((bm_alloc(ileaf) + bm_alloc(iroot)) > bm_alloc_tot) then  ! leaf is with higher priority
187          if (biomass(icarbres) >= (bm_alloc(ileaf) + bm_alloc(iroot)- bm_alloc_tot)) then
188             bm_alloc(ileaf) = c_leafb
189             bm_alloc(iroot) = reprac*bm_alloc_tot
190             !c_reserve = c_reserve - (bm_alloc(ileaf) + bm_alloc(iroot)-bm_alloc_tot)
191             bm_alloc(icarbres) = 0. - (bm_alloc(ileaf) + bm_alloc(iroot)- bm_alloc_tot)
192          else
193             bm_alloc(ileaf) = c_leafb
194             bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ileaf) + biomass(icarbres)
195             !c_reserve = 0.
196             bm_alloc(icarbres) = 0. - biomass(icarbres)
197          endif
198       !else if ((bm_alloc(ileaf) + bm_alloc(iroot) + bm_alloc(ifruit)) >= bm_alloc_tot) then
199       !   
200       !   bm_alloc(ileaf) = c_leafb
201       !   bm_alloc(iroot) = reprac*bm_alloc_tot
202       !   bm_alloc(ifruit) = bm_alloc_tot-bm_alloc(iroot)-bm_alloc(ileaf)
203       !   bm_alloc(ifruit) = max(0., bm_alloc(ifruit))
204       else !
205          bm_alloc(isapabove) = bm_alloc_tot -bm_alloc(ileaf) - bm_alloc(iroot)
206          bm_alloc(icarbres) = 0.
207       endif
208    endif
209 
210   
211    ! 3.3 STAGE [ndrp nlax]
212    ! in this stage, the allocation of leaf and grain is with higher priority
213    ! second, root and sapwoodabove
214    ! at the same times, we put some parts into reserve
215       
216    if ((ndrp > 0) .and. (nlax == 0)) then ! from frain filling to lai plateau
217       
218       ! in this stage the c_reserve should used out
219       if ( biomass(icarbres) > 0. ) then
220          bm_alloc(isapabove) = biomass(icarbres)
221          bm_alloc(icarbres) = 0. - biomass(icarbres) ! in this stage, the carbon reserve should be used out.
222       endif
223
224       ! initilize the values
225       bm_alloc(iroot) = reprac*bm_alloc_tot             
226       !bm_alloc(icarbres) = P_densitesem*pgrain ! original reserve fraction
227
228       !if (bm_alloc(ileaf) >= bm_alloc_tot) then
229       if (bm_alloc(ifruit) >= bm_alloc_tot) then
230          bm_alloc(ileaf) = 0. 
231          bm_alloc(ifruit) = deltmagrain ! keep the grain yield
232          bm_alloc(iroot) = 0. - (deltmagrain - bm_alloc_tot)*reprac
233          bm_alloc(isapabove) = 0. - (deltmagrain - bm_alloc_tot)*(1.0 - reprac)
234          bm_alloc(icarbres) = 0.
235       else if ((bm_alloc(ileaf)+ bm_alloc(ifruit)) >= bm_alloc_tot) then  ! 
236          bm_alloc(ifruit) = deltmagrain !bm_alloc_tot - bm_alloc(ileaf)
237          bm_alloc(ileaf) = bm_alloc_tot - bm_alloc(ifruit) ! remaining
238          bm_alloc(iroot) = 0.
239          bm_alloc(isapabove) = 0.
240          bm_alloc(icarbres) = 0.
241       else if ((bm_alloc(ileaf)+ bm_alloc(ifruit) + bm_alloc(iroot)) >= bm_alloc_tot) then
242          bm_alloc(ifruit) = deltmagrain
243          bm_alloc(ileaf) = c_leafb
244          bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ifruit)-bm_alloc(ileaf)
245          bm_alloc(icarbres) = 0.
246          bm_alloc(isapabove) = 0.
247       !else if ((bm_alloc(ileaf)+ bm_alloc(ifruit) + bm_alloc(iroot) + bm_alloc(icarbres)) >= bm_alloc_tot) then
248       !   ! that means there is some remainings after allocating carbon to leaf, grain, and reserve.
249       !   bm_alloc(icarbres) = bm_alloc_tot - bm_alloc(ileaf)- bm_alloc(ifruit)-bm_alloc(iroot)
250       else
251          bm_alloc(ifruit) = deltmagrain
252          bm_alloc(ileaf) = c_leafb
253          bm_alloc(iroot) = reprac*bm_alloc_tot
254          !bm_alloc(icarbres) = P_densitesem*pgrain
255          bm_alloc(isapabove) = bm_alloc_tot-bm_alloc(ileaf)- bm_alloc(ifruit)- bm_alloc(iroot)
256       endif
257    endif
258
259   
260    ! 3.4 STAGE [nlax nrec]
261    ! in this stage, the allocation  of leaf is 0. Whereas, the allocation of grain and reserve is with higher priority
262    ! grain
263    ! sapwood
264    ! root
265
266    if ((nlax > 0) .and. (nrec == 0)) then ! from lai plateau to harvest
267       ! initilize the values
268       !bm_alloc(ifruit) = magrain   ! fruit fraction
269       !bm_alloc(icarbres) = P_densitesem*pgrain ! original reserve fraction
270       !bm_alloc(ileaf) = c_leafb ! leaf fraction
271       bm_alloc(iroot) = reprac*bm_alloc_tot             
272       
273       if (bm_alloc(ifruit) >= bm_alloc_tot) then  ! highest priority
274          bm_alloc(ifruit) = deltmagrain
275          bm_alloc(icarbres) = 0.         
276          bm_alloc(ileaf) = 0.
277          bm_alloc(iroot) = 0. - (deltmagrain - bm_alloc_tot)*reprac
278          bm_alloc(isapabove) = 0. - (deltmagrain - bm_alloc_tot)*(1.0 - reprac)
279       !else if ((bm_alloc(ifruit) + bm_alloc(icarbres)) >= bm_alloc_tot) then  ! former
280       else if ((bm_alloc(ifruit) + bm_alloc(iroot)) >= bm_alloc_tot) then  ! 
281          bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ifruit)
282          bm_alloc(ileaf) = 0.
283          bm_alloc(icarbres) = 0.
284      ! else if ((bm_alloc(ifruit) + bm_alloc(icarbres) + bm_alloc(iroot))>= bm_alloc_tot) then
285      !    bm_alloc(iroot) = bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(icarbres)
286      !    bm_alloc(ileaf) = 0.
287      ! else if ((bm_alloc(ifruit) + bm_alloc(icarbres) + bm_alloc(iroot) + bm_alloc(ileaf)) >= bm_alloc_tot) then
288      !    ! that means there is some remainings after allocating carbon to leaf, grain and reserve.
289      !    bm_alloc(ileaf) = bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(icarbres)-bm_alloc(iroot)
290       else
291          ! that means NPP is enough, we
292          !bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(icarbres)-bm_alloc(iroot) - bm_alloc(ileaf)
293          !bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(iroot)
294          bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(iroot)
295       endif
296    endif
297   
298    ! 3.5 STAGE [When nrec occur]
299    ! when harvest, we alloc some carbon into reservoire pool
300   
301    if ( nrec /= 0 ) then  ! harvest occurs
302       bm_alloc(iroot) = reprac*bm_alloc_tot
303       if (bm_alloc(ifruit) >= bm_alloc_tot) then
304          bm_alloc(ifruit) = deltmagrain
305          bm_alloc(icarbres) = 0.         
306          bm_alloc(ileaf) = 0.
307          bm_alloc(iroot) = 0. - (deltmagrain - bm_alloc_tot)*reprac
308          bm_alloc(isapabove) = 0. - (deltmagrain - bm_alloc_tot)*(1.0 - reprac)
309       else if ((bm_alloc(ifruit) + bm_alloc(iroot)) >= bm_alloc_tot) then
310          bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ifruit)
311          bm_alloc(ileaf) = 0.
312          bm_alloc(icarbres) = 0.
313       else
314          bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(iroot)
315       endif
316       ! but we have to put some carbon into reserve (seeds for the next year)
317       c_reserve = P_densitesem*pgrain*0.48 ! seeds
318       biomass(ifruit) =  biomass(ifruit) - c_reserve   !max(grainrem, 0.);
319       bm_alloc(icarbres) = c_reserve
320       DO ipart = 1,nparts
321           IF (bm_alloc(ipart)<0) THEN
322               WRITE(numout,*) 'ipart :',ipart
323               WRITE(numout,*) 'bm_alloc < 0 :',bm_alloc(ipart)
324               WRITE(numout,*) 'biomass :', biomass(ipart)
325           ENDIF
326       ENDDO
327    endif
328 
329end subroutine crop_bmalloc
330
331end module crop_alloc
Note: See TracBrowser for help on using the repository browser.