source: branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90 @ 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: 16.1 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                      nmat,             &
30                      nrec,             &
31!                      is_recycle,       &
32                      bm_alloc_tot,     &    ! input
33                      biomass,          &
34                      c_reserve,        &    ! out
35                      c_leafb,          &    ! out
36                      bm_alloc,         &    ! inout
37                      P_densitesem,     &
38                      P_pgrainmaxi,     &
39                      P_tigefeuil,     &
40                      P_slamax,        &
41                      slai,            &
42                      tday_counter)               ! parameter
43
44   !USE ioipsl
45   !USE pft_parameters
46   !USE constantes
47   
48   ! Declaration part
49   
50   ! 0.0 INPUT PART
51   LOGICAL, INTENT(IN)                 :: in_cycle           
52   REAL(r_std),  INTENT(IN)            :: deltai         ! lai increment  // unit in m2 m-2
53   REAL(r_std),  INTENT(IN)            :: dltaisen       ! lai senescence  // unit in m2 m-2
54   REAL(r_std),  INTENT(IN)            :: ssla           ! sla from STICS // unit in g cm -2
55   REAL(r_std),  INTENT(IN)            :: pgrain         ! weight per grain (dry matter, but not carbon)  // g
56   REAL(r_std),  INTENT(IN)            :: deltgrain        ! grain yield increment (dry matter but not carbon)  // unit g c / m2
57   REAL(r_std),  INTENT(IN)            :: reprac 
58   INTEGER(i_std),  INTENT(IN)            :: nger
59   INTEGER(i_std),  INTENT(IN)            :: nlev 
60   INTEGER(i_std),  INTENT(IN)            :: ndrp
61   INTEGER(i_std),  INTENT(IN)            :: nlax
62   INTEGER(i_std),  INTENT(IN)            :: nmat
63   INTEGER(i_std),  INTENT(IN)            :: nrec
64!   LOGICAL,  INTENT(IN)                   :: is_recycle
65   REAL(r_std), INTENT(IN)             :: bm_alloc_tot   ! unit in g m-2
66   REAL(r_std),  INTENT(IN)            :: P_densitesem
67   REAL(r_std),  INTENT(IN)            :: P_tigefeuil
68   REAL(r_std),  INTENT(IN)            :: P_pgrainmaxi
69   REAL(r_std),  INTENT(IN)            :: P_slamax
70   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)             :: biomass   ! unit in g m-2
71   INTEGER(i_std), INTENT(IN)             :: tday_counter
72   ! 1.0 INOUT PART
73
74   REAL(r_std), INTENT(INOUT)            ::c_reserve  ! crop reserve
75   REAL(r_std), INTENT(INOUT)            ::c_leafb ! crop leaf biomass derived from STICS
76   REAL(r_std), INTENT(INOUT)            ::slai ! stics simulated lai
77   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)            ::bm_alloc ! crop leaf biomass derived from STICS
78   
79   ! 2.0 local
80   REAL(r_std)      ::  grainrem   ! daily grain minus reservoir, the remaining carbon
81   REAL(r_std)      ::  deltmagrain   ! daily grain/ (unit in carbon)
82   INTEGER(i_std)   :: ipart
83   REAL(r_std)      :: tempalloc
84   REAL(r_std)      :: tempdlai
85   REAL(r_std)      :: netdeltai
86   REAL(r_std)      :: temprest
87   REAL(r_std)      :: maxremobi,sla0,sla1,remobi
88   LOGICAL, PARAMETER :: mydebug=.FALSE.
89
90
91    ! Part one: conversion from biomass(dry matter) to carbon
92    deltmagrain = deltgrain*0.48
93
94    ! STRATEGY:
95    ! We keep the leaf biomass, grain and reprac from STICS
96    ! Total available biomass for allocation is dltams and cropreserv.
97
98    !IF (bavard .GE. 3) WRITE(numout,*) 'Entering crop alloc'
99   
100    ! 1. whether or not necessary to enter into this process
101   
102    if (.not. in_cycle) then
103        return   ! if not yet into the crop cycle or finish the cycle
104    endif
105
106    ! 1. initialize the bm_alloc (biomass allocation)
107    !
108
109    bm_alloc(:) = 0.      ! 8 parts
110       
111    ! 2.  leaf biomass from STICS
112    ! 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)
113    c_leafb = 0.
114    if (in_cycle) then
115       if (deltai > 0.) then  ! just for leaf growth period
116           c_leafb = deltai/ssla*10000.0*0.48
117       elseif (deltai < 0.) then
118           c_leafb = deltai/ssla*10000.0*0.48
119       else
120           c_leafb = 0.
121       endif
122    else
123       c_leafb = 0.
124    endif
125    netdeltai = deltai - dltaisen
126 
127   
128    ! 3. reinitialization of leaf and fruit biomass
129    if (biomass(ileaf) .gt. 0.0) then
130        sla0 = slai/biomass(ileaf)
131    else
132        sla0 = P_slamax
133    endif
134    if (sla0 .eq. 0.0) then
135        sla0 = P_slamax
136    endif
137    if (sla0 .LT. 0) then
138       write(*,*) 'allocation sla error: sla0,',sla0
139       STOP
140    endif
141    bm_alloc(ileaf) = c_leafb - dltaisen/sla0
142    if (bm_alloc(ileaf) .LT. 0 .and. netdeltai .GT. 0) then
143        write(*,*) 'allocation leaf error: bm_alloc(ileaf)',bm_alloc(ileaf)
144    endif
145    if (bm_alloc(ileaf)<0 .and. biomass(ileaf)+bm_alloc(ileaf)<0) then
146        bm_alloc(ileaf) = -biomass(ileaf)
147    endif
148    bm_alloc(ifruit)= deltmagrain
149    bm_alloc(iroot) = bm_alloc_tot * reprac
150    if (reprac .GE. 1.) then
151       write(numout,*) 'reprac > 1: ',reprac
152       stop
153    endif
154    bm_alloc(isapabove) = P_tigefeuil * c_leafb
155    bm_alloc(icarbres) = 0.
156
157    if (mydebug) then
158        write(numout,*) 'xuhui, alloc initial:'
159        write(numout,*) 'biomass(ileaf) ', biomass(ileaf)
160        write(numout,*) 'slai ', slai
161        write(numout,*) 'sla0 ', sla0
162        write(numout,*) 'deltai ', deltai
163        write(numout,*) 'dltaisen ', dltaisen
164        write(numout,*) 'reprac ', reprac
165        write(numout,*) 'deltmagrain ', deltmagrain
166        write(numout,*) 'P_tigefeuil ', P_tigefeuil
167        write(numout,*) 'bm_alloc_tot ', bm_alloc_tot
168        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit) '
169        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit)
170        write(numout,*) 'nger nlev nlax ndrp nrec '
171        write(numout,*)  nger, nlev, nlax, ndrp,  nrec
172        write(numout,*) 'biomass(ileaf, isapabove, iroot, ifruit, icarbres) '
173        write(numout,*)  biomass(ileaf), biomass(isapabove), biomass(iroot), biomass(ifruit), biomass(icarbres)
174    endif
175   
176    ! it is possible that bm_alloc(ileaf) is negative
177 
178    ! 4.  real allocation for each grid and each pft
179
180
181    ! STRATEGY:
182    ! 1. carbon allocation priority is different for different parts;
183    ! 2. even for the same pool, the priority is changing along with time (stage revolution)
184   
185    ! 3.1 FOR STAGE [nger, nlev]
186
187    ! the c_reserve starts to decreasing because the root growth
188    ! and we allocate all carbon into root
189
190    if ((nger .gt. 0) .and. (nlev .eq. 0)) then ! germination occured but did not emerge, during this stage only root and reserve pools
191       if ( biomass(icarbres) > 0.) then  ! adjust the reserve dynamics
192          ! addressing the c_reserve dynamics
193          bm_alloc(iroot) = biomass(icarbres)*reprac 
194          bm_alloc(icarbres) = 0. - biomass(icarbres)*reprac 
195          bm_alloc(ileaf) = 0.
196          bm_alloc(isapabove) = 0.
197          bm_alloc(ifruit) = 0.
198       else
199          !c_reserve = 0.
200          bm_alloc(icarbres) = 0.
201          bm_alloc(iroot) = 0.
202          bm_alloc(ileaf) = 0.
203          bm_alloc(isapabove) = 0.
204          bm_alloc(ifruit) = 0.
205       endif
206    endif
207   
208    ! 3.2 FOR STAGE [NLEV, NDRP)
209    if ((nlev .gt. 0) .and. (ndrp .eq. 0)) then 
210    ! emergence and photosynthese, whereas grain is not filling
211    ! in this stage, we keep the leaf and grain biomass
212    ! root with the higher priority
213        tempalloc =  bm_alloc(ileaf)+bm_alloc(iroot)+bm_alloc(isapabove)
214        bm_alloc(ifruit) = 0.
215        if (tempalloc > bm_alloc_tot) then
216            if (tempalloc < bm_alloc_tot + biomass(icarbres)) then               
217!                biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
218                bm_alloc(icarbres) = - (tempalloc - bm_alloc_tot)
219            else ! new c + c reserve is insufficient to meet the demand
220                if (biomass(icarbres)<0) then
221                    biomass(icarbres) = 0.
222                    bm_alloc(icarbres) = 0.
223                else
224                    bm_alloc(icarbres) = - biomass(icarbres)
225                endif
226                bm_alloc(iroot) = reprac * bm_alloc_tot
227                if ( tday_counter >= nlev .and. tday_counter < nlev+8) then ! we create some biomass for leaf at the beginning
228                    bm_alloc(ileaf) = deltai/P_slamax*10000.0*0.48
229                    bm_alloc(icarbres) = -bm_alloc(ileaf)
230                else
231                    tempdlai = (bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot))/(1+P_tigefeuil)*ssla/10000.0/0.48
232                    bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
233                    bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
234                    if (netdeltai > tempdlai) then
235                        slai = slai - (netdeltai - tempdlai)
236                    endif
237                endif
238            endif
239        else
240            bm_alloc(icarbres) = bm_alloc_tot - tempalloc
241        endif
242!        if (bm_alloc(ileaf)<0) then ! remobilize the leaf biomass for future use (grain mainly)
243!           bm_alloc(icarbres) = bm_alloc(icarbres) - bm_alloc(ileaf)
244!        endif
245!    endif
246 
247   
248    ! 3.3 STAGE [ndrp nrec)
249    ! in this stage, there is potentially competition between leaf and fruit,
250    ! conserve root/shoot ratio, fulfil grain first, reduce deltai when necessary
251    ! note that leaf growth stop at nlax, grain filling stop at nmat
252    ! no fundamental differences exist for [nlax, nmat)
253       
254    else if ((ndrp .gt. 0) .and. ( (nmat .eq. 0) .or. (tday_counter .eq. nmat))) then ! from grain filling to maturity
255       tempalloc =  bm_alloc(ileaf)+bm_alloc(ifruit)+bm_alloc(iroot)+bm_alloc(isapabove)
256
257       if (tempalloc > bm_alloc_tot) then
258           if (tempalloc < bm_alloc_tot + biomass(icarbres)) then ! use c reserval
259!               biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
260               bm_alloc(icarbres) = - (tempalloc - bm_alloc_tot)
261           else ! new c + c reserval is insufficient to meet the demand
262               if (biomass(icarbres)<0) then
263                   biomass(icarbres) = 0.
264               else
265                   bm_alloc(icarbres) = 0. - biomass(icarbres)
266               endif
267               bm_alloc(iroot) = reprac * bm_alloc_tot
268               if (bm_alloc(ileaf)>=0) then
269                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot)
270               else ! bm_alloc(ileaf) < 0
271                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(ileaf) - bm_alloc(iroot)
272               endif
273               if (temprest < bm_alloc(ifruit)) then ! if not sufficient for grain alone
274                   if (nlax .gt. 0) then ! remobilize some carbon from leaf
275                       sla0 = slai/biomass(ileaf)*10000.0*0.48 ! m2/gC --> cm2/g drymass
276                       sla1 = min(sla0+5,P_slamax)
277                       maxremobi = slai/(sla0/0.48/10000.0) - slai/(sla1/0.48/10000)   !cm2/g --> m2/gC
278                       remobi = min(maxremobi, bm_alloc(ifruit)-temprest)
279                       
280                       bm_alloc(ifruit) = temprest + remobi
281                       bm_alloc(ileaf) = min(bm_alloc(ileaf),0.) - remobi
282                       ! when bm_alloc(ileaf)<0, further remove remobi
283                       ! when bm_alloc(ileaf)>0, then stop the planned location to lai
284                       bm_alloc(isapabove) = 0.
285                   else
286                       bm_alloc(ifruit) = temprest
287                       bm_alloc(ileaf) = min(0., bm_alloc(ileaf))
288                       bm_alloc(isapabove) = 0.
289                       if (netdeltai>0) then
290                           slai = slai - netdeltai
291                       endif
292                   endif
293               else !temprest >= bm_alloc(ifruit)
294                   if (bm_alloc(ileaf)<0) then ! the rest is left in reserval
295                       bm_alloc(icarbres) = temprest - bm_alloc(ifruit)
296                   else !  the rest goes to leaf
297                       tempdlai = (temprest - bm_alloc(ifruit))/(1+P_tigefeuil)*ssla/10000.0/0.48
298                       bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
299                       bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
300                       if (netdeltai > tempdlai) then ! which is almost guarantee because bm_alloc(ileaf)>0
301                           slai = slai - (netdeltai - tempdlai)
302                       endif
303                   endif
304               endif
305           endif
306       else
307           bm_alloc(icarbres) = bm_alloc_tot - tempalloc
308       endif   
309!    endif
310
311    ! 3.5 stage [nmat nrec)
312    else if ((nmat .gt. 0) .and. (nrec .eq. 0))  then
313        ! xuhui noted:
314        ! in STICS, nmat = physiology maturity, which means
315        ! harvested organs stop growing in dry matter (p20 STICS book)
316        ! It is difficult to imagine vegetative part (leaf, root) are still growing,
317        ! while the harvest organs are not. So my decision is that
318        ! no allocation to any parts of the crop
319        ! = no more npp
320        if (bm_alloc(ileaf)<0) then
321            bm_alloc(isapabove) = -bm_alloc(ileaf)
322            bm_alloc(iroot) = 0.
323            bm_alloc(ifruit) = 0.
324            bm_alloc(icarbres) = 0.
325        else
326            bm_alloc(:) = 0.
327        endif
328!    endif   
329!    ! 3.5 STAGE [When nrec occur]
330!    ! when harvest, we alloc some carbon into reservoire pool
331!   
332!    else if ( nrec .gt. 0  .OR.  (nmat .GT. 0 .AND. is_recycle) ) then  ! harvest occurs
333    else if ( nrec .gt. 0 ) then  ! harvest occurs
334!    ! only allocate to root & grain
335!       bm_alloc(isapabove) = 0.
336!       if (bm_alloc(ileaf)<0)  then
337!           tempalloc =  bm_alloc(ifruit) + bm_alloc(iroot) + bm_alloc(ileaf)
338!       else !bm_alloc(ileaf)>0 ! this should be a buggy boundary condition
339!           bm_alloc(ileaf) = 0.
340!           tempalloc = bm_alloc(ifruit) + bm_alloc(iroot)
341!       endif
342!
343!       if (tempalloc >= bm_alloc_tot) then !no enough c
344!          bm_alloc(ifruit) = bm_alloc_tot - bm_alloc(iroot)
345!          bm_alloc(icarbres) = 0.         
346!       else
347!          bm_alloc(icarbres) =bm_alloc_tot - tempalloc
348!       endif
349       ! but we have to put some carbon into reserve (seeds for the next year)
350       c_reserve = P_densitesem*pgrain*0.48 ! seeds
351       bm_alloc(ileaf) = 0. !at harvest, the senescence will be treated as litter, not as re-allocation
352       if (biomass(icarbres) > 0.) then
353           bm_alloc(isapabove) = biomass(icarbres) !the rest of c reservoire will be return to soil as litter
354           bm_alloc(icarbres) = -biomass(icarbres)
355       else
356           bm_alloc(isapabove) = 0.
357           bm_alloc(icarbres) = 0.
358       endif
359!       biomass(ifruit) =  biomass(ifruit) - c_reserve   !max(grainrem, 0.);
360       bm_alloc(ifruit) = -c_reserve
361       bm_alloc(icarbres) = bm_alloc(icarbres) + c_reserve
362       DO ipart = 1,nparts
363           IF (bm_alloc(ipart)<0) THEN
364               WRITE(numout,*) 'ipart :',ipart
365               WRITE(numout,*) 'bm_alloc < 0 :',bm_alloc(ipart)
366               WRITE(numout,*) 'biomass :', biomass(ipart)
367           ENDIF
368       ENDDO
369    else
370!        write(numout,*) 'growth stage not recognized'
371        write(numout,*) 'no allocation occurred in tday_counter: ', tday_counter
372        write(numout,*) 'nger, nlev, ndrp, nmat, nrec'
373        write(numout,*) nger, nlev, ndrp, nmat, nrec
374!        STOP
375    endif
376
377    if (mydebug)  then
378        write(numout,*) 'xuhui, leaving crop_alloc'
379        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit,icarbres) '
380        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit), bm_alloc(icarbres)
381        write(numout,*) 'slai: ', slai
382    endif
383 
384end subroutine crop_bmalloc
385
386end module crop_alloc
Note: See TracBrowser for help on using the repository browser.