source: branches/publications/ORCHIDEE_CAN_r2290/src_stomate/lpj_cover.f90 @ 6859

Last change on this file since 6859 was 1243, checked in by sebastiaan.luyssaert, 12 years ago

number of individuals is now a prognostic variable for all woody PFTs and woody PFTs are calculated for different diameter classes. All seems to work for multiple years for the woody PFTs except for the fire module which should be rewritten to make use of the different diameter classes. Grasses and crops are not properly working yet. Note that none of the parameters have been checked. They just happen to work from a numerical point of view
  • Property svn:keywords set to HeadURL Date Author Revision
File size: 12.8 KB
Line 
1! =================================================================================================================================
2! MODULE       : lpj_cover
3!
4! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
5!
6! LICENCE      : IPSL (2006)
7!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF        Recalculate vegetation cover and LAI
10!!
11!!\n DESCRIPTION : None
12!!
13!! RECENT CHANGE(S) : None
14!!
15!! REFERENCE(S) :
16!!        Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
17!!        plant geography and terrestrial carbon cycling in the LPJ dynamic
18!!        global vegetation model, Global Change Biology, 9, 161-185.\n
19!!        Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
20!!        dynamics in the modelling of terrestrial ecosystems: comparing two
21!!        contrasting approaches within European climate space,
22!!        Global Ecology and Biogeography, 10, 621-637.\n
23!!
24!! SVN :
25!! $HeadURL$
26!! $Date$
27!! $Revision$
28!! \n
29!_ ================================================================================================================================
30
31MODULE lpj_cover
32
33  ! modules used:
34
35  USE ioipsl_para
36  USE stomate_data
37  USE pft_parameters
38
39  IMPLICIT NONE
40
41  ! private & public routines
42
43  PRIVATE
44  PUBLIC cover
45
46CONTAINS
47
48!! ================================================================================================================================
49!! SUBROUTINE     : lpj_cover
50!!
51!>\BRIEF          Recalculate vegetation cover and LAI
52!!
53!!\n DESCRIPTION : Veget_max is first renewed here according to newly calculated foliage biomass in this calculation step
54!! Then, litter, soil carbon, and biomass are also recalcuted with taking into account the changes in Veget_max (i.e. delta_veg)
55!! Grid-scale fpc (foliage projected coverage) is calculated to obtain the shadede ground area by leaf's light capture
56!! Finally, grid-scale fpc is adjusted not to exceed 1.0
57!!
58!! RECENT CHANGE(S) : None
59!!
60!! MAIN OUTPUT VARIABLE(S) : ::lai (leaf area index, @tex $(m^2 m^{-2})$ @endtex),
61!! :: veget (fractional vegetation cover, unitless)
62!!
63!! REFERENCE(S)   : None
64!!
65!! FLOWCHART :
66!! \latexonly
67!!     \includegraphics[scale=0.5]{lpj_cover_flowchart.png}
68!! \endlatexonly
69!! \n
70!_ ================================================================================================================================
71
72  SUBROUTINE cover (npts, cn_ind, ind, biomass, &
73       veget_max, veget_max_old, lai, litter, carbon, turnover_daily, bm_to_litter, &
74       lignin_struc, lignin_wood)
75
76!! 0. Variable and parameter declaration
77
78    !! 0.1 Input variables
79
80    INTEGER(i_std), INTENT(in)                                  :: npts             !! Domain size (unitless) 
81    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: cn_ind           !! Crown area
82                                                                                    !! @tex $(m^2)$ @endtex per individual
83    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: ind              !! Number of individuals
84                                                                                    !! @tex $(m^{-2})$ @endtex
85    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: veget_max_old    !! "Maximal" coverage fraction of a PFT (LAI->
86                                                                                    !! infinity) on ground at beginning of time
87
88    !! 0.2 Output variables
89
90
91    !! 0.3 Modified variables
92
93    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: lai                 !! Leaf area index OF AN INDIVIDUAL PLANT
94                                                                                       !! @tex $(m^2 m^{-2})$ @endtex
95    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout) :: litter    !! Metabolic and structural litter, above and
96                                                                                       !! below ground @tex $(gC m^{-2})$ @endtex
97    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout)             :: carbon        !! Carbon pool: active, slow, or passive
98                                                                                       !! @tex $(gC m^{-2})$ @endtex
99    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
100    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: veget_max      !! "Maximal" coverage fraction of a PFT (LAI->
101                                                                                       !! infinity) on ground (unitless)
102    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily !! Turnover rates (gC m^{-2} day^{-1})
103    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Conversion of biomass to litter
104                                                                                       !! @tex $(gC m^{-2} day^{-1})$ @endtex
105    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout)            :: lignin_struc   !! ratio Lignine/Carbon in structural litter,
106                                                                                       !! above and below ground
107    REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(inout)            :: lignin_wood    !! ratio Lignine/Carbon in woody litter,
108                                                                                       !! above and below ground
109 
110    !! 0.4 Local variables
111
112    INTEGER(i_std)                                              :: i,j,k,m          !! Index (unitless)
113    REAL(r_std), DIMENSION(npts,nlitt,nlevs,nelements)          :: dilu_lit         !! Litter dilution @tex $(gC m^{-2})$ @endtex
114    REAL(r_std), DIMENSION(npts,ncarb)                          :: dilu_soil_carbon !! Soil Carbondilution
115                                                                                    !! @tex $(gC m^{-2})$ @endtex
116    REAL(r_std), DIMENSION(npts,nlevs)                          :: dilu_lf_struc    !! fraction of structural litter that is lignin
117                                                                                    !! (0-1,unitless)
118    REAL(r_std), DIMENSION(npts,nlevs)                          :: dilu_lf_wood     !! fraction of woody litter that is lignin
119                                                                                    !! (0-1,unitless)
120    REAL(r_std), DIMENSION(nvm)                                 :: delta_veg        !! Conversion factors (unitless)
121    REAL(r_std), DIMENSION(nvm)                                 :: reduct           !! Conversion factors (unitless)
122    REAL(r_std)                                                 :: delta_veg_sum    !! Conversion factors (unitless)
123    REAL(r_std)                                                 :: diff             !! Conversion factors (unitless)
124    REAL(r_std)                                                 :: sr               !! Conversion factors (unitless)
125    REAL(r_std), DIMENSION(npts)                                :: frac_nat         !! Conversion factors (unitless)
126    REAL(r_std), DIMENSION(npts)                                :: sum_vegettree    !! Conversion factors (unitless)
127    REAL(r_std), DIMENSION(npts)                                :: sum_vegetgrass   !! Conversion factors (unitless)
128    REAL(r_std), DIMENSION(npts)                                :: sum_veget_natveg !! Conversion factors (unitless)
129
130!_ ================================================================================================================================
131
132 !! 1. If the vegetation is dynamic, calculate new maximum vegetation cover for natural plants
133
134       !! 1.1  Calculate initial values of vegetation cover
135       frac_nat(:) = un
136       sum_veget_natveg(:) = zero
137       veget_max(:,ibare_sechiba) = un
138
139       DO j = 2,nvm ! loop over PFTs
140
141          IF ( natural(j) ) THEN
142             
143             ! Summation of individual tree crown area to get total foliar projected coverage
144             veget_max(:,j) = ind(:,j) * cn_ind(:,j)
145             sum_veget_natveg(:) = sum_veget_natveg(:) + veget_max(:,j)
146
147          ELSE
148             
149             !fraction occupied by agriculture needs to be substracted for the DGVM
150             !this is used below to constrain veget for natural vegetation, see below
151             frac_nat(:) = frac_nat(:) - veget_max(:,j)
152
153          ENDIF
154
155       ENDDO ! loop over PFTs
156
157       DO i = 1, npts ! loop over grid points
158         
159          ! Recalculation of vegetation projected coverage when ::frac_nat was below ::sum_veget_natveg
160          ! It means that non-natural vegetation will recover ::veget_max as natural vegetation
161          IF (sum_veget_natveg(i) .GT. frac_nat(i) .AND. frac_nat(i) .GT. min_stomate) THEN
162
163             DO j = 2,nvm ! loop over PFTs
164                IF( natural(j) ) THEN
165                   veget_max(i,j) =  veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i)
166                ENDIF
167             ENDDO ! loop over PFTs
168
169          ENDIF
170       ENDDO ! loop over grid points
171       
172       ! Renew veget_max of bare soil as 0 to difference of veget_max (ibare_sechiba)
173       ! to current veget_max
174       DO j = 2,nvm ! loop over PFTs
175          veget_max(:,ibare_sechiba) = veget_max(:,ibare_sechiba) - veget_max(:,j)
176       ENDDO ! loop over PFTs
177       veget_max(:,ibare_sechiba) = MAX( veget_max(:,ibare_sechiba), zero )
178
179       !! 1.2 Calculate carbon fluxes between PFTs to maintain mass balance
180       !      Recalculate the litter and soil carbon with taking into accout the change in
181       !      veget_max (delta_veg)
182       DO i = 1, npts ! loop over grid points
183         
184          ! calculate the change in veget_max between previous time step and current time step
185          delta_veg(:) = veget_max(i,:)-veget_max_old(i,:)
186          delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero)
187
188          dilu_lit(i,:,:,:) = zero
189          dilu_soil_carbon(i,:) = zero
190          dilu_lf_struc(i,:) = zero
191          dilu_lf_wood(i,:) = zero
192
193          DO j=1, nvm ! loop over PFTs
194             IF ( delta_veg(j) < -min_stomate ) THEN
195                dilu_lit(i,:,:,:) =  dilu_lit(i,:,:,:) + delta_veg(j) * litter(i,:,j,:,:) / delta_veg_sum
196                dilu_soil_carbon(i,:) =  dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
197                dilu_lf_struc(i,:) = dilu_lf_struc(i,:) + & 
198                     delta_veg(j) * lignin_struc(i,j,:) * litter(i,istructural,j,:,icarbon)/ delta_veg_sum
199                dilu_lf_wood(i,:) = dilu_lf_wood(i,:) + &
200                     delta_veg(j) * lignin_wood(i,j,:)*litter(i,iwoody,j,:,icarbon)  / delta_veg_sum
201             ENDIF
202          ENDDO ! loop over PFTs
203
204          DO j = 1,nvm ! loop over PFTs
205             IF ( delta_veg(j) > min_stomate) THEN
206
207                ! Dilution of reservoirs
208                ! Recalculate the litter and soil carbon with taking into accout the change in
209                ! veget_max (delta_veg)
210
211                ! Lignin fraction of structural litter
212                lignin_struc(i,j,:)=(lignin_struc(i,j,:) * veget_max_old(i,j)* litter(i,istructural,j,:,icarbon) + & 
213                     dilu_lf_struc(i,:) * delta_veg(j)) / veget_max(i,j) 
214
215                ! Lignin fraction of woody litter
216                lignin_wood(i,j,:)=(lignin_wood(i,j,:) * veget_max_old(i,j)* litter(i,iwoody,j,:,icarbon) + & 
217                     dilu_lf_wood(i,:) * delta_veg(j)) / veget_max(i,j)
218
219                 ! Litter
220                litter(i,:,j,:,:)=(litter(i,:,j,:,:) * veget_max_old(i,j) + dilu_lit(i,:,:,:) * delta_veg(j)) / veget_max(i,j)
221
222                WHERE ( litter(i,istructural,j,:,icarbon) > min_stomate )
223                   lignin_struc(i,j,:) = lignin_struc(i,j,:)/litter(i,istructural,j,:,icarbon)
224                ELSEWHERE
225                   lignin_struc(i,j,:) = LC(ileaf)
226                ENDWHERE
227
228                WHERE ( litter(i,iwoody,j,:,icarbon) > min_stomate )
229                   lignin_struc(i,j,:) = lignin_struc(i,j,:)/litter(i,iwoody,j,:,icarbon)
230                ELSEWHERE
231                   lignin_struc(i,j,:) = LC(iheartabove)
232                ENDWHERE
233
234
235               ! Soil carbon
236                carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max(i,j)
237
238             ENDIF
239
240             IF((j.GE.2).AND.(veget_max_old(i,j).GT.min_stomate).AND.(veget_max(i,j).GT.min_stomate)) THEN
241
242                ! Correct biomass densities (i.e. also litter fall) to conserve mass
243                ! since it's defined on veget_max
244                biomass(i,j,:,:) = biomass(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
245                turnover_daily(i,j,:,:) = turnover_daily(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
246                bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
247
248             ENDIF
249
250          ENDDO ! loop over PFTs
251       ENDDO ! loop over grid points
252
253  END SUBROUTINE cover
254
255END MODULE lpj_cover
Note: See TracBrowser for help on using the repository browser.