source: branches/publications/ORCHIDEE_GLUC_r6545/src_sticslai/crop_alloc.f90.new @ 7346

Last change on this file since 7346 was 3751, checked in by albert.jornet, 8 years ago

New: CROP module. Done by Xuhui.
File size: 13.2 KB
Line 
1! This subrutine is addressing the Carbon allocation for crops in combination with STICS
2! Author: Xuhui Wang
3! Date: 03/12/2014
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_tigefeuil
63   REAL(r_std),  INTENT(IN)            :: P_pgrainmaxi
64   REAL(r_std),  INTENT(IN)            :: P_slamax
65   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)             :: biomass   ! unit in g m-2
66   
67   ! 1.0 INOUT PART
68
69   REAL(r_std), INTENT(INOUT)            ::c_reserve  ! crop reserve
70   REAL(r_std), INTENT(INOUT)            ::c_leafb ! crop leaf biomass derived from STICS
71   REAL(r_std), INTENT(INOUT)            ::slai ! stics simulated lai
72   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)            ::bm_alloc ! crop leaf biomass derived from STICS
73   
74   ! 2.0 local
75   REAL(r_std)      ::  grainrem   ! daily grain minus reservoir, the remaining carbon
76   REAL(r_std)      ::  deltmagrain   ! daily grain/ (unit in carbon)
77   INTEGER(i_std)   :: ipart
78   REAL(r_std)      :: tempalloc
79   REAL(r_std)      :: tempdlai
80   REAL(r_std)      :: netdeltai
81   REAL(r_std)      :: temprest
82   REAL(r_std)      :: maxremobi,sla0,sla1,remobi
83   LOGICAL, PARAMETER :: mydebug=.TRUE.
84
85
86    ! Part one: conversion from biomass(dry matter) to carbon
87    deltmagrain = deltgrain*0.48
88
89    ! STRATEGY:
90    ! We keep the leaf biomass, grain and reprac from STICS
91    ! Total available biomass for allocation is dltams and cropreserv.
92
93    !IF (bavard .GE. 3) WRITE(numout,*) 'Entering crop alloc'
94   
95    ! 1. whether or not necessary to enter into this process
96   
97    if (.not. in_cycle) return   ! if not yet into the crop cycle or finish the cycle
98
99    ! 1. initialize the bm_alloc (biomass allocation)
100    !
101
102    bm_alloc(:) = 0.      ! 8 parts
103       
104    ! 2.  leaf biomass from STICS
105    ! 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)
106    c_leafb = 0.
107    if (in_cycle) then
108       if (deltai > 0.) then  ! just for leaf growth period
109           c_leafb = deltai/ssla*10000.0*0.48
110       elseif (netdeltai < 0.) then
111           c_leafb = deltai/ssla*10000.0*0.48
112       else
113           c_leafb = 0.
114       endif
115    else
116       c_leafb = 0.
117    endif
118    netdeltai = deltai - dltaisen
119 
120   
121    ! 3. reinitialization of leaf and fruit biomass
122    if (biomass(ileaf) .gt. 0) then
123        sla0 = slai/biomass(ileaf)
124    else
125        sla0 = P_slamax
126    endif
127    bm_alloc(ileaf) = c_leafb - dltaisen/sla0
128    if (bm_alloc(ileaf)<0 .and. biomass(ileaf)+bm_alloc(ileaf)<0) then
129        bm_alloc(ileaf) = -biomass(ileaf)
130    endif
131    bm_alloc(ifruit)= deltmagrain
132    bm_alloc(iroot) = bm_alloc_tot * reprac
133    if (reprac .GE. 1.) then
134       write(numout,*) 'reprac > 1: ',reprac
135       stop
136    endif
137    bm_alloc(isapabove) = P_tigefeuil * c_leafb
138    bm_alloc(icarbres) = 0.
139
140    if (mydebug) then
141        write(numout,*) 'xuhui, alloc initial:'
142        write(numout,*) 'biomass(ileaf) ', biomass(ileaf)
143        write(numout,*) 'slai ', slai
144        write(numout,*) 'sla0 ', sla0
145        write(numout,*) 'deltai ', deltai
146        write(numout,*) 'dltaisen ', dltaisen
147        write(numout,*) 'reprac ', reprac
148        write(numout,*) 'deltmagrain ', deltmagrain
149        write(numout,*) 'P_tigefeuil ', P_tigefeuil
150        write(numout,*) 'bm_alloc_tot ', bm_alloc_tot
151        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit) '
152        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit)
153        write(numout,*) 'nger nlev nlax ndrp nrec '
154        write(numout,*)  nger, nlev, nlax, ndrp,  nrec
155        write(numout,*) 'biomass(ileaf, isapabove, iroot, ifruit, icarbres) '
156        write(numout,*)  biomass(ileaf), biomass(isapabove), biomass(iroot), biomass(ifruit), biomass(icarbres)
157    endif
158   
159    ! it is possible that bm_alloc(ileaf) is negative
160 
161    ! 4.  real allocation for each grid and each pft
162
163
164    ! STRATEGY:
165    ! 1. carbon allocation priority is different for different parts;
166    ! 2. even for the same pool, the priority is changing along with time (stage revolution)
167   
168    ! 3.1 FOR STAGE [nger, nlev]
169
170    ! the c_reserve starts to decreasing because the root growth
171    ! and we allocate all carbon into root
172
173    if ((nger .gt. 0) .and. (nlev .eq. 0)) then ! germination occured but did not emerge, during this stage only root and reserve pools
174       if ( biomass(icarbres) > 0.) then  ! adjust the reserve dynamics
175          ! addressing the c_reserve dynamics
176          bm_alloc(iroot) = biomass(icarbres)*reprac
177          bm_alloc(icarbres) = 0. - biomass(icarbres)*reprac
178          bm_alloc(ileaf) = 0.
179          bm_alloc(isapabove) = 0.
180          bm_alloc(ifruit) = 0.
181       else
182          !c_reserve = 0.
183          bm_alloc(icarbres) = 0.
184          bm_alloc(iroot) = 0.
185          bm_alloc(ileaf) = 0.
186          bm_alloc(isapabove) = 0.
187          bm_alloc(ifruit) = 0.
188       endif
189    endif
190   
191    ! 3.2 FOR STAGE [NLEV, NDRP)
192    if ((nlev .gt. 0) .and. (ndrp .eq. 0)) then
193    ! emergence and photosynthese, whereas grain is not filling
194    ! in this stage, we keep the leaf and grain biomass
195    ! root with the higher priority
196        tempalloc =  bm_alloc(ileaf)+bm_alloc(iroot)+bm_alloc(isapabove)
197        bm_alloc(ifruit) = 0.
198        if (tempalloc > bm_alloc_tot) then
199            if (tempalloc < bm_alloc_tot + biomass(icarbres)) then               
200                biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
201            else ! new c + c reserve is insufficient to meet the demand
202                if (biomass(icarbres)<0) biomass(icarbres) = 0.
203                bm_alloc(iroot) = reprac * bm_alloc_tot
204                tempdlai = (bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot))/(1+P_tigefeuil)*ssla/10000.0/0.48
205                bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
206                bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
207                if (netdeltai > tempdlai) then
208                    slai = slai - (netdeltai - tempdlai)
209                endif
210            endif
211        else
212            bm_alloc(icarbres) = bm_alloc_tot - tempalloc
213        endif
214!        if (bm_alloc(ileaf)<0) then ! remobilize the leaf biomass for future use (grain mainly)
215!           bm_alloc(icarbres) = bm_alloc(icarbres) - bm_alloc(ileaf)
216!        endif
217    endif
218 
219   
220    ! 3.3 STAGE [ndrp nrec)
221    ! in this stage, there is potentially competition between leaf and fruit,
222    ! conserve root/shoot ratio, fulfil grain first, reduce deltai when necessary
223    ! note that leaf growth stop at nlax, grain filling stop at nmat
224    ! no fundamental differences exist for [nlax, nrec)
225       
226    if ((ndrp .gt. 0) .and. (nrec .eq. 0)) then ! from frain filling to lai plateau
227       tempalloc =  bm_alloc(ileaf)+bm_alloc(ifruit)+bm_alloc(iroot)+bm_alloc(isapabove)
228
229       if (tempalloc > bm_alloc_tot) then
230           if (tempalloc < bm_alloc_tot + biomass(icarbres)) then ! use c reserval
231               biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
232           else ! new c + c reserval is insufficient to meet the demand
233               if (biomass(icarbres)<0) biomass(icarbres) = 0.
234               bm_alloc(iroot) = reprac * bm_alloc_tot
235               if (bm_alloc(ileaf)>=0) then
236                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot)
237               else ! bm_alloc(ileaf) < 0
238                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(ileaf) - bm_alloc(iroot)
239               endif
240               if (temprest < bm_alloc(ifruit)) then ! if not sufficient for grain alone
241                   if (nlax .gt. 0) then ! remobilize some carbon from leaf
242                       sla0 = slai/biomass(ileaf)*10000.0*0.48 ! m2/gC --> cm2/g drymass
243                       sla1 = min(sla0+10,P_slamax)
244                       maxremobi = slai/(sla0/0.48/10000.0) - slai/(sla1/0.48/10000)   !cm2/g --> m2/gC
245                       remobi = min(maxremobi, bm_alloc(ifruit)-temprest)
246                       
247                       bm_alloc(ifruit) = temprest + remobi
248                       bm_alloc(ileaf) = min(bm_alloc(ileaf),0.) - remobi
249                       ! when bm_alloc(ileaf)<0, further remove remobi
250                       ! when bm_alloc(ileaf)>0, then stop the planned location to lai
251                       bm_alloc(isapabove) = 0.
252                   else
253                       bm_alloc(ifruit) = temprest
254                       bm_alloc(ileaf) = min(0., bm_alloc(ileaf))
255                       bm_alloc(isapabove) = 0.
256                       if (netdeltai>0) then
257                           slai = slai - netdeltai
258                       endif
259                   endif
260               else !temprest >= bm_alloc(ifruit)
261                   if (bm_alloc(ileaf)<0) then ! the rest is left in reserval
262                       bm_alloc(icarbres) = temprest - bm_alloc(ifruit)
263                   else !  the rest goes to leaf
264                       tempdlai = (temprest - bm_alloc(ifruit))/(1+P_tigefeuil)*ssla/10000.0/0.48
265                       bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
266                       bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
267                       if (netdeltai > tempdlai) then ! which is almost guarantee because bm_alloc(ileaf)>0
268                           slai = slai - (netdeltai - tempdlai)
269                       endif
270                   endif
271               endif
272           endif
273       else
274           bm_alloc(icarbres) = bm_alloc_tot - tempalloc
275       endif   
276    endif
277
278   
279    ! 3.5 STAGE [When nrec occur]
280    ! when harvest, we alloc some carbon into reservoire pool
281   
282    if ( nrec .gt. 0 ) then  ! harvest occurs
283    ! only allocate to root & grain
284       bm_alloc(isapabove) = 0.
285       if (bm_alloc(ileaf)<0)  then
286           tempalloc =  bm_alloc(ifruit) + bm_alloc(iroot) + bm_alloc(ileaf)
287       else !bm_alloc(ileaf)>0 ! this should be a buggy boundary condition
288           bm_alloc(ileaf) = 0.
289           tempalloc = bm_alloc(ifruit) + bm_alloc(iroot)
290       endif
291
292       if (tempalloc >= bm_alloc_tot) then !no enough c
293          bm_alloc(ifruit) = bm_alloc_tot - bm_alloc(iroot)
294          bm_alloc(icarbres) = 0.         
295       else
296          bm_alloc(icarbres) =bm_alloc_tot - tempalloc
297       endif
298       ! but we have to put some carbon into reserve (seeds for the next year)
299       c_reserve = P_densitesem*pgrain*0.48 ! seeds
300       biomass(ifruit) =  biomass(ifruit) - c_reserve   !max(grainrem, 0.);
301       bm_alloc(icarbres) = c_reserve
302       DO ipart = 1,nparts
303           IF (bm_alloc(ipart)<0) THEN
304               WRITE(numout,*) 'ipart :',ipart
305               WRITE(numout,*) 'bm_alloc < 0 :',bm_alloc(ipart)
306               WRITE(numout,*) 'biomass :', biomass(ipart)
307           ENDIF
308       ENDDO
309    endif
310
311    if (mydebug)  then
312        write(numout,*) 'xuhui, leaving crop_alloc'
313        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit,icarbres) '
314        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit), bm_alloc(icarbres)
315    endif
316 
317end subroutine crop_bmalloc
318
319end module crop_alloc
Note: See TracBrowser for help on using the repository browser.