1 | ! recalculate vegetation cover and LAI |
---|
2 | ! |
---|
3 | ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_cover.f90,v 1.9 2010/04/06 15:44:01 ssipsl Exp $ |
---|
4 | ! IPSL (2006) |
---|
5 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
---|
6 | ! |
---|
7 | MODULE lpj_cover |
---|
8 | |
---|
9 | ! modules used: |
---|
10 | |
---|
11 | USE ioipsl |
---|
12 | USE stomate_constants |
---|
13 | USE constantes_veg |
---|
14 | |
---|
15 | IMPLICIT NONE |
---|
16 | |
---|
17 | ! private & public routines |
---|
18 | |
---|
19 | PRIVATE |
---|
20 | PUBLIC cover |
---|
21 | |
---|
22 | CONTAINS |
---|
23 | |
---|
24 | SUBROUTINE cover (npts, cn_ind, ind, biomass, & |
---|
25 | veget_max, veget_max_old, veget, lai, litter, carbon, turnover_daily, bm_to_litter) |
---|
26 | |
---|
27 | ! |
---|
28 | ! 0 declarations |
---|
29 | ! |
---|
30 | |
---|
31 | ! 0.1 input |
---|
32 | |
---|
33 | ! Domain size |
---|
34 | INTEGER(i_std), INTENT(in) :: npts |
---|
35 | ! crown area (m**2) per ind. |
---|
36 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: cn_ind |
---|
37 | ! density of individuals (1/(m**2 of ground)) |
---|
38 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ind |
---|
39 | ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground at beginning of time step |
---|
40 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max_old |
---|
41 | |
---|
42 | ! 0.2 modified fields |
---|
43 | ! biomass (gC/(m**2 of ground)) |
---|
44 | REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: biomass |
---|
45 | ! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground |
---|
46 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget_max |
---|
47 | ! Turnover rates (gC/(m**2 of ground)/day) |
---|
48 | REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: turnover_daily |
---|
49 | ! conversion of biomass to litter (g/m**2 / day |
---|
50 | REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: bm_to_litter |
---|
51 | |
---|
52 | ! 0.3 output |
---|
53 | |
---|
54 | ! fractional coverage on ground, taking into account LAI (=grid-scale fpc) |
---|
55 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: veget |
---|
56 | ! leaf area index OF AN INDIVIDUAL PLANT |
---|
57 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lai |
---|
58 | |
---|
59 | ! metabolic and structural litter, above and below ground (gC/(m**2 of ground)) |
---|
60 | REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs), INTENT(inout) :: litter |
---|
61 | ! carbon pool: active, slow, or passive,(gC/(m**2 of ground)) |
---|
62 | REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon |
---|
63 | |
---|
64 | ! 0.4 local |
---|
65 | |
---|
66 | ! index |
---|
67 | INTEGER(i_std) :: i,j,k,m |
---|
68 | |
---|
69 | ! Litter dilution (gC/m²) |
---|
70 | REAL(r_std),DIMENSION(npts,nlitt,nlevs) :: dilu_lit |
---|
71 | ! Soil Carbondilution (gC/m²) |
---|
72 | REAL(r_std),DIMENSION(npts,ncarb) :: dilu_soil_carbon |
---|
73 | |
---|
74 | ! conversion vectors |
---|
75 | REAL(r_std),DIMENSION(nvm) :: delta_veg,reduct |
---|
76 | ! vecteur de conversion |
---|
77 | REAL(r_std) :: delta_veg_sum,diff,sr |
---|
78 | REAL(r_std), DIMENSION(npts) :: frac_nat,sum_vegettree,sum_vegetgrass |
---|
79 | REAL(r_std), DIMENSION(npts) :: sum_veget_natveg |
---|
80 | |
---|
81 | ! ========================================================================= |
---|
82 | |
---|
83 | ! |
---|
84 | ! 1 If the vegetation is dynamic, calculate new maximum vegetation cover for |
---|
85 | ! natural plants |
---|
86 | ! |
---|
87 | |
---|
88 | IF ( control%ok_dgvm ) THEN |
---|
89 | |
---|
90 | ! some initialisations |
---|
91 | frac_nat(:) = un |
---|
92 | sum_veget_natveg(:) = zero |
---|
93 | sum_vegettree(:) = zero |
---|
94 | sum_vegetgrass(:) = zero |
---|
95 | |
---|
96 | veget_max(:,ibare_sechiba) = un |
---|
97 | |
---|
98 | DO j = 2,nvm |
---|
99 | |
---|
100 | IF ( natural(j) ) THEN |
---|
101 | |
---|
102 | veget_max(:,j) = ind(:,j) * cn_ind(:,j) |
---|
103 | sum_veget_natveg(:) = sum_veget_natveg(:) + veget_max(:,j) |
---|
104 | |
---|
105 | ELSE |
---|
106 | !fraction occupied by agriculture needs to be substracted for the DGVM |
---|
107 | !this is used below to constrain veget for natural vegetation, see below |
---|
108 | frac_nat(:) = frac_nat(:) - veget_max(:,j) |
---|
109 | |
---|
110 | ENDIF |
---|
111 | |
---|
112 | ENDDO |
---|
113 | |
---|
114 | DO i = 1, npts |
---|
115 | |
---|
116 | IF (sum_veget_natveg(i) .GT. frac_nat(i) .AND. frac_nat(i) .GT. min_stomate) THEN |
---|
117 | |
---|
118 | DO j = 2,nvm |
---|
119 | IF( natural(j) ) THEN |
---|
120 | veget_max(i,j) = veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i) |
---|
121 | ENDIF |
---|
122 | ENDDO |
---|
123 | |
---|
124 | ENDIF |
---|
125 | ENDDO |
---|
126 | |
---|
127 | DO j = 2,nvm |
---|
128 | veget_max(:,ibare_sechiba) = veget_max(:,ibare_sechiba) - veget_max(:,j) |
---|
129 | ENDDO |
---|
130 | veget_max(:,ibare_sechiba) = MAX( veget_max(:,ibare_sechiba), zero ) |
---|
131 | |
---|
132 | ! 1.3 calculate carbon fluxes between PFTs to maintain mass balance |
---|
133 | ! |
---|
134 | |
---|
135 | DO i = 1, npts |
---|
136 | ! Generation of the conversion vector |
---|
137 | |
---|
138 | delta_veg(:) = veget_max(i,:)-veget_max_old(i,:) |
---|
139 | delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero) |
---|
140 | |
---|
141 | dilu_lit(i,:,:) = zero |
---|
142 | dilu_soil_carbon(i,:) = zero |
---|
143 | DO j=1, nvm |
---|
144 | IF ( delta_veg(j) < -min_stomate ) THEN |
---|
145 | dilu_lit(i,:,:)= dilu_lit(i,:,:) + delta_veg(j)*litter(i,:,j,:) / delta_veg_sum |
---|
146 | dilu_soil_carbon(i,:)= dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum |
---|
147 | ENDIF |
---|
148 | ENDDO |
---|
149 | |
---|
150 | DO j=1, nvm |
---|
151 | IF ( delta_veg(j) > min_stomate) THEN |
---|
152 | |
---|
153 | ! Dilution of reservoirs |
---|
154 | |
---|
155 | ! Litter |
---|
156 | litter(i,:,j,:)=(litter(i,:,j,:) * veget_max_old(i,j) + dilu_lit(i,:,:) * delta_veg(j)) / veget_max(i,j) |
---|
157 | |
---|
158 | ! Soil carbon |
---|
159 | carbon(i,:,j)=(carbon(i,:,j) * veget_max_old(i,j) + dilu_soil_carbon(i,:) * delta_veg(j)) / veget_max(i,j) |
---|
160 | |
---|
161 | ENDIF |
---|
162 | |
---|
163 | IF(j.GE.2.AND.veget_max_old(i,j).GT.min_stomate.AND.veget_max(i,j).GT.min_stomate) THEN |
---|
164 | |
---|
165 | ! Correct biomass densities (i.e. also litter fall) to conserve mass |
---|
166 | ! since it's defined on veget_max |
---|
167 | |
---|
168 | biomass(i,j,:)=biomass(i,j,:)*veget_max_old(i,j)/veget_max(i,j) |
---|
169 | turnover_daily(i,j,:)=turnover_daily(i,j,:)*veget_max_old(i,j)/veget_max(i,j) |
---|
170 | bm_to_litter(i,j,:)=bm_to_litter(i,j,:)*veget_max_old(i,j)/veget_max(i,j) |
---|
171 | |
---|
172 | ENDIF |
---|
173 | |
---|
174 | ENDDO |
---|
175 | ENDDO |
---|
176 | ENDIF |
---|
177 | |
---|
178 | ! |
---|
179 | ! 2 Calculate LAI |
---|
180 | ! The LAI is defined on the space covered by the crown of the plant. |
---|
181 | ! ( biomass / veget_max ) is in gC/(m**2 covered by the crown) |
---|
182 | ! |
---|
183 | !MM in Soenke code but not in merge version ; must keep that ?? |
---|
184 | !NV, MM : we keep those comments for compatibility with CMIP5 computations. |
---|
185 | !! They have to be uncommented avec CMIP5 versions in the trunk ! |
---|
186 | !!$ DO j = 2,nvm |
---|
187 | !!$ lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j) |
---|
188 | !!$ ENDDO |
---|
189 | |
---|
190 | ! |
---|
191 | ! 3 calculate grid-scale fpc (foliage protected cover) |
---|
192 | ! |
---|
193 | |
---|
194 | DO j = 2,nvm |
---|
195 | DO i = 1, npts |
---|
196 | IF (lai(i,j) == val_exp) THEN |
---|
197 | veget(i,j) = veget_max(i,j) |
---|
198 | ELSE |
---|
199 | IF ( control%ok_dgvm ) THEN |
---|
200 | !!$SZneed to check this - this formulation will cause 100% veget, otherwise there will always |
---|
201 | !!$ be some percent bare ground |
---|
202 | veget(i,j) = ind(i,j) * cn_ind(i,j) * ( un - EXP( - lai(i,j) * ext_coeff(j) ) ) |
---|
203 | ELSE |
---|
204 | veget(i,j) = veget_max(i,j) * ( un - EXP( - lai(i,j) * ext_coeff(j) ) ) |
---|
205 | ENDIF |
---|
206 | ENDIF |
---|
207 | |
---|
208 | ! check sums of fpc for natural vegetation (see correction below!) in dynamic mode |
---|
209 | IF ( control%ok_dgvm ) THEN |
---|
210 | |
---|
211 | IF(natural(j))THEN |
---|
212 | IF(tree(j)) THEN |
---|
213 | sum_vegettree(i)=sum_vegettree(i)+veget(i,j) |
---|
214 | ELSE |
---|
215 | sum_vegetgrass(i)=sum_vegetgrass(i)+veget(i,j) |
---|
216 | ENDIF |
---|
217 | ENDIF |
---|
218 | |
---|
219 | ENDIF |
---|
220 | ENDDO |
---|
221 | ENDDO |
---|
222 | |
---|
223 | |
---|
224 | ! 3.1 correct gridscale fpc for dynamic vegetation |
---|
225 | !!$SZ, this part should be obsolete now that veget_max is forced to 1.0 |
---|
226 | !!$ nevertheless maintained just for savety. Whoever wants to test |
---|
227 | !!$ whether this works without is invited to do so. |
---|
228 | |
---|
229 | ! in the DGVM mode, we can arrive at a sum of veget slighly exceeding 1.0, |
---|
230 | ! because mainly of grass dynamics... |
---|
231 | ! In this case, we devide the fpar over natural vegetation first such that |
---|
232 | ! grasses are shadowed by trees, and in the theoretically impossible case that |
---|
233 | ! this is not sufficient, reduce proportionally all veget's. |
---|
234 | ! |
---|
235 | IF ( control%ok_dgvm ) THEN |
---|
236 | |
---|
237 | DO i = 1,npts |
---|
238 | |
---|
239 | diff=sum_vegettree(i)+sum_vegetgrass(i)-frac_nat(i) |
---|
240 | reduct(:) = 0. |
---|
241 | ! ordinary case, the reason too much grasses |
---|
242 | ! reduce grass veget to match the maximum |
---|
243 | IF (diff .GT. 0. ) THEN |
---|
244 | |
---|
245 | IF (sum_vegetgrass(i).GT.min_stomate) THEN |
---|
246 | sr=0. |
---|
247 | DO j=2,nvm |
---|
248 | IF(natural(j).AND..NOT.tree(j)) THEN |
---|
249 | reduct(j)=-MIN(diff,sum_vegetgrass(i))*veget(i,j)/sum_vegetgrass(i) |
---|
250 | sr=sr+reduct(j) |
---|
251 | ENDIF |
---|
252 | ENDDO |
---|
253 | diff=diff+sr |
---|
254 | ENDIF |
---|
255 | |
---|
256 | ENDIF |
---|
257 | |
---|
258 | ! this is theoretically impossible, since trees can only occupy 95%, |
---|
259 | ! but better be save than sorry |
---|
260 | IF (diff .GT. min_stomate ) THEN |
---|
261 | |
---|
262 | IF (sum_vegettree(i).GT.min_stomate) THEN |
---|
263 | sr=0. |
---|
264 | DO j=2,nvm |
---|
265 | IF(natural(j).AND.tree(j)) THEN |
---|
266 | reduct(j)=-MIN(diff,sum_vegettree(i))*veget(i,j)/sum_vegettree(i) |
---|
267 | sr=sr+reduct(j) |
---|
268 | ENDIF |
---|
269 | ENDDO |
---|
270 | diff=diff+sr |
---|
271 | ENDIF |
---|
272 | |
---|
273 | ENDIF |
---|
274 | |
---|
275 | !!$ ! tell user if the problem could not be resolved |
---|
276 | !!$ ! in theory the model should stop here! |
---|
277 | !!$ IF (diff .GT. min_stomate ) THEN |
---|
278 | !!$ |
---|
279 | !!$ write(numout,*) 'ATT, DGVM!: veget exceeds bareground without vegetation left' |
---|
280 | !!$ write(numout,*) 'ATT, DGVM!: is this a bug? cell: ',i |
---|
281 | !!$ write(numout,*) 'ATT, DGVM!: veget ',veget(i,:) |
---|
282 | !!$ |
---|
283 | !!$ ENDIF |
---|
284 | |
---|
285 | ! finally, implement the reduction. (reduc is negative!) |
---|
286 | veget(i,:)=veget(i,:)+reduct(:) |
---|
287 | |
---|
288 | ENDDO |
---|
289 | |
---|
290 | ENDIF |
---|
291 | |
---|
292 | veget(:,ibare_sechiba) = un |
---|
293 | DO j = 2,nvm |
---|
294 | veget(:,ibare_sechiba) = veget(:,ibare_sechiba) - veget(:,j) |
---|
295 | ENDDO |
---|
296 | |
---|
297 | END SUBROUTINE cover |
---|
298 | |
---|
299 | END MODULE lpj_cover |
---|