Changeset 257 for branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_light.f90
- Timestamp:
- 2011-06-17T14:02:17+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_light.f90
r64 r257 14 14 ! Exclude agricultural pfts from competition 15 15 ! 16 ! SZ: added light competition for the static case if the mortality is not 17 ! assumed to be constant. 18 ! other modifs: 19 ! -1 FPC is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is 20 ! to represent community ecology effects; seasonal variations in establishment related to phenology 21 ! may be relevant, but beyond the scope of a 1st generation DGVM 22 ! -2 problem, if agriculture is present, fpc can never reach 1.0 since natural veget_max < 1.0. To 23 ! correct for this, ind must be recalculated to correspond to the natural density... 24 ! since ind is 1/m2 grid cell, this can be achived by dividing ind by the agricultural fraction 25 26 ! 16 27 ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/lpj_light.f90,v 1.8 2009/01/06 15:01:25 ssipsl Exp $ 17 28 ! IPSL (2006) … … 43 54 44 55 SUBROUTINE light (npts, dt, & 45 PFTpresent, cn_ind, lai, maxfpc_lastyear, &46 ind, biomass, veget_lastlight, bm_to_litter)56 veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, & 57 lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality) 47 58 48 59 ! … … 64 75 ! last year's maximum fpc for each natural PFT, on ground 65 76 REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear 77 ! last year's maximum leafmass for each natural PFT, on ground 78 REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lm_lastyearmax 79 ! last year's maximum fpc for each natural PFT, on ground 80 REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max 81 ! last year's maximum fpc for each natural PFT, on ground 82 REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fpc_max 66 83 67 84 ! 0.2 modified fields … … 75 92 ! biomass taken away (gC/m**2) 76 93 REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: bm_to_litter 94 ! fraction of individuals that died this time step 95 REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: mortality 77 96 78 97 ! 0.3 local 79 98 80 99 ! index 81 INTEGER(i_std) :: i,j 100 INTEGER(i_std) :: i,j,k,m 82 101 ! total natural fpc 83 102 REAL(r_std), DIMENSION(npts) :: sumfpc 103 ! fraction of natural vegetation at grid cell level 104 REAL(r_std), DIMENSION(npts) :: fracnat 84 105 ! total natural woody fpc 85 106 REAL(r_std) :: sumfpc_wood … … 100 121 ! Fraction of plants that survive 101 122 REAL(r_std), DIMENSION(nvm) :: survive 123 ! FPC for static mode 124 REAL(r_std), DIMENSION(npts) :: fpc_real 125 ! FPC mortality for static mode 126 REAL(r_std), DIMENSION(npts) :: lai_ind 102 127 ! number of grass PFTs present in the grid box 103 INTEGER(i_std) :: num_grass128 ! INTEGER(i_std) :: num_grass 104 129 ! New total grass fpc 105 130 REAL(r_std) :: sumfpc_grass2 106 131 ! fraction of plants that dies each day (1/day) 107 132 REAL(r_std), DIMENSION(npts,nvm) :: light_death 133 ! Relative change of number of individuals for trees 134 REAL(r_std) :: fpc_dec 108 135 109 136 ! ========================================================================= … … 139 166 ENDIF 140 167 141 ! 142 ! 2 fpc characteristics 143 ! 144 145 ! 146 ! 2.1 calculate fpc on natural part of grid cell. 147 ! 148 149 DO j = 2, nvm 150 151 IF ( natural(j) ) THEN 152 153 ! 2.1.1 natural PFTs 154 155 IF ( tree(j) ) THEN 156 157 ! 2.1.1.1 trees: minimum cover due to stems, branches etc. 158 159 DO i = 1, npts 160 IF (lai(i,j) == val_exp) THEN 161 fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 162 ELSE 163 fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 164 MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 165 ENDIF 166 ENDDO 168 IF (control%ok_dgvm) THEN 169 ! 170 ! 2 fpc characteristics 171 ! 172 173 ! 2.0 Only natural part of the grid cell: 174 ! calculate fraction of natural and agricultural (1-fracnat) surface 175 176 fracnat(:) = 1. 177 DO j = 2,nvm 178 IF ( .NOT. natural(j) ) THEN 179 fracnat(:) = fracnat(:) - veget_max(:,j) 180 ENDIF 181 ENDDO 182 ! 183 ! 2.1 calculate fpc on natural part of grid cell. 184 ! 185 fpc_nat(:,:)=zero 186 fpc_nat(:,ibare_sechiba)=un 187 188 DO j = 2, nvm 189 190 IF ( natural(j) ) THEN 191 192 ! 2.1.1 natural PFTs 193 194 IF ( tree(j) ) THEN 195 196 ! 2.1.1.1 trees: minimum cover due to stems, branches etc. 197 198 ! DO i = 1, npts 199 ! IF (lai(i,j) == val_exp) THEN 200 ! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 201 ! ELSE 202 ! fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 203 ! MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 204 ! ENDIF 205 ! ENDDO 206 207 !NV : modif from SZ version : fpc is based on veget_max, not veget. 208 WHERE(fracnat(:).GE.min_stomate) 209 ! WHERE(LAI(:,j) == val_exp) 210 ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 211 ! ELSEWHERE 212 ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * & 213 ! MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover ) 214 ! ENDWHERE 215 fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 216 ENDWHERE 217 218 ELSE 219 220 !NV : modif from SZ version : fpc is based on veget_max, not veget. 221 WHERE(fracnat(:).GE.min_stomate) 222 ! WHERE(LAI(:,j) == val_exp) 223 ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 224 ! ELSEWHERE 225 ! fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * & 226 ! ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ) 227 ! ENDWHERE 228 fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) 229 ENDWHERE 230 231 !!$ ! 2.1.1.2 bare ground 232 !!$ IF (j == ibare_sechiba) THEN 233 !!$ fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) 234 !!$ 235 !!$ ! 2.1.1.3 grasses 236 !!$ ELSE 237 !!$ DO i = 1, npts 238 !!$ IF (lai(i,j) == val_exp) THEN 239 !!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 240 !!$ ELSE 241 !!$ fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 242 !!$ ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ) 243 !!$ ENDIF 244 !!$ ENDDO 245 !!$ ENDIF 246 247 ENDIF ! tree/grass 167 248 168 249 ELSE 169 250 170 ! 2.1.1.2 bare ground 171 IF (j == ibare_sechiba) THEN 172 fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) 173 174 ! 2.1.1.3 grasses 251 ! 2.1.2 agricultural PFTs: not present on natural part 252 253 fpc_nat(:,j) = zero 254 255 ENDIF ! natural/agricultural 256 257 ENDDO 258 259 ! 260 ! 2.2 sum natural fpc for every grid point 261 ! 262 263 sumfpc(:) = zero 264 DO j = 2,nvm 265 !SZ bug correction MERGE: need to subtract agricultural area! 266 sumfpc(:) = sumfpc(:) + fpc_nat(:,j) 267 ENDDO 268 269 ! 270 ! 3 Light competition 271 ! 272 273 light_death(:,:) = zero 274 275 DO i = 1, npts ! SZ why this loop and not a vector statement ? 276 277 ! Only if vegetation cover is dense 278 279 IF ( sumfpc(i) .GT. fpc_crit ) THEN 280 281 ! fpc change for each pft 282 ! There are two possibilities: either we compare today's fpc with the fpc after the last 283 ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case, 284 ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season. 285 ! As for trees, the cutback is proportional to this increase, this means that seasonal trees 286 ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its 287 ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.) 288 289 IF ( annual_increase ) THEN 290 deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero ) 175 291 ELSE 176 DO i = 1, npts 177 IF (lai(i,j) == val_exp) THEN 178 fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) 292 deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero ) 293 ENDIF 294 295 ! default: survive 296 297 survive(:) = 1.0 298 299 ! 300 ! 3.1 determine some characteristics of the fpc distribution 301 ! 302 303 sumfpc_wood = zero 304 sumdelta_fpc_wood = zero 305 maxfpc_wood = zero 306 optpft_wood = 0 307 sumfpc_grass = zero 308 ! num_grass = 0 309 310 DO j = 2,nvm 311 312 ! only natural pfts 313 314 IF ( natural(j) ) THEN 315 316 IF ( tree(j) ) THEN 317 318 ! trees 319 320 ! total woody fpc 321 322 sumfpc_wood = sumfpc_wood + fpc_nat(i,j) 323 324 ! how much did the woody fpc increase 325 326 sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j) 327 328 ! which woody pft is preponderant 329 330 IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN 331 332 optpft_wood = j 333 334 maxfpc_wood = fpc_nat(i,j) 335 336 ENDIF 337 179 338 ELSE 180 fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * & 181 ( un - exp( -lai(i,j) * ext_coeff(j) ) ) 182 ENDIF 183 ENDDO 184 ENDIF 185 ENDIF ! tree/grass 186 187 ELSE 188 189 ! 2.1.2 agricultural PFTs: not present on natural part 190 191 fpc_nat(:,j) = 0.0 192 193 ENDIF ! natural/agricultural 194 195 ENDDO 196 197 ! 198 ! 2.2 sum natural fpc for every grid point 199 ! 200 201 sumfpc(:) = zero 202 DO j = 2,nvm 203 !SZ bug correction MERGE: need to subtract agricultural area! 204 sumfpc(:) = sumfpc(:) + fpc_nat(:,j) 205 ENDDO 206 207 ! 208 ! 3 Light competition 209 ! 210 211 light_death(:,:) = 0.0 212 213 DO i = 1, npts ! SZ why this loop and not a vector statement ? 214 215 ! Only if vegetation cover is dense 216 217 IF ( sumfpc(i) .GT. fpc_crit ) THEN 218 219 ! fpc change for each pft 220 ! There are two possibilities: either we compare today's fpc with the fpc after the last 221 ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case, 222 ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season. 223 ! As for trees, the cutback is proportional to this increase, this means that seasonal trees 224 ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its 225 ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.) 226 227 IF ( annual_increase ) THEN 228 deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)), zero ) 229 ELSE 230 deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), zero ) 231 ENDIF 232 233 ! default: survive 234 235 survive(:) = 1.0 236 237 ! 238 ! 3.1 determine some characteristics of the fpc distribution 239 ! 240 241 sumfpc_wood = 0.0 242 sumdelta_fpc_wood = 0.0 243 maxfpc_wood = 0.0 244 optpft_wood = 0 245 sumfpc_grass = 0.0 246 num_grass = 0 247 248 DO j = 2,nvm 249 250 ! only natural pfts 251 252 IF ( natural(j) ) THEN 253 254 IF ( tree(j) ) THEN 255 256 ! trees 257 258 ! total woody fpc 259 260 sumfpc_wood = sumfpc_wood + fpc_nat(i,j) 261 262 ! how much did the woody fpc increase 263 264 sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j) 265 266 ! which woody pft is preponderant 267 268 IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN 269 270 optpft_wood = j 271 272 maxfpc_wood = fpc_nat(i,j) 273 274 ENDIF 275 276 ELSE 277 339 278 340 ! grasses 279 341 280 342 ! total (natural) grass fpc 281 343 282 344 sumfpc_grass = sumfpc_grass + fpc_nat(i,j) 283 345 284 346 ! number of grass PFTs present in the grid box 285 286 IF ( PFTpresent(i,j) ) THEN287 num_grass = num_grass + 1288 ENDIF289 347 348 ! IF ( PFTpresent(i,j) ) THEN 349 ! num_grass = num_grass + 1 350 ! ENDIF 351 290 352 ENDIF ! tree or grass 291 353 292 354 ENDIF ! natural 293 355 294 356 ENDDO ! loop over pfts 295 357 296 358 ! 297 359 ! 3.2 light competition: assume wood outcompetes grass 298 360 ! 299 300 IF (sumfpc_wood .GE. fpc_crit ) THEN 301 302 ! 303 ! 3.2.1 all allowed natural space is covered by wood: 304 ! cut back trees to fpc_crit. 305 ! Original DGVM: kill grasses. Modified: we let a very 306 ! small fraction of grasses survive. 307 ! 308 361 !SZ 362 !!$ IF (sumfpc_wood .GE. fpc_crit ) THEN 363 364 ! 365 ! 3.2.1 all allowed natural space is covered by wood: 366 ! cut back trees to fpc_crit. 367 ! Original DGVM: kill grasses. Modified: we let a very 368 ! small fraction of grasses survive. 369 ! 370 371 DO j = 2,nvm 372 373 ! only present and natural pfts compete 374 375 IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 376 377 IF ( tree(j) ) THEN 378 379 ! 380 ! 3.2.1.1 tree 381 ! 382 383 ! no single woody pft is overwhelming 384 ! (original DGVM: tree_mercy = 0.0 ) 385 ! The reduction rate is proportional to the ratio deltafpc/fpc. 386 387 IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. & 388 sumdelta_fpc_wood .GT. min_stomate) THEN 389 390 ! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * & 391 ! (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), & 392 ! ( 1._r_std - tree_mercy ) ) 393 reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) & 394 * deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un ) 395 396 ELSE 397 398 ! tree fpc didn't icrease or it started from nothing 399 400 reduct = zero 401 402 ENDIF 403 404 survive(j) = un - reduct 405 406 ELSE 407 408 ! 409 ! 3.2.1.2 grass: let a very small fraction survive (the sum of all 410 ! grass individuals may make up a maximum cover of 411 ! grass_mercy [for lai -> infinity]). 412 ! In the original DGVM, grasses were killed in that case, 413 ! corresponding to grass_mercy = 0. 414 ! 415 416 ! survive(j) = ( grass_mercy / REAL( num_grass,r_std ) ) / ind(i,j) 417 418 ! survive(j) = MIN( 1._r_std, survive(j) 419 420 IF(sumfpc_grass .GE. 1.0-MIN(fpc_crit,sumfpc_wood).AND. & 421 sumfpc_grass.GE.min_stomate) THEN 422 423 fpc_dec=(sumfpc_grass-1.+MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass 424 425 reduct=fpc_dec 426 ELSE 427 reduct = zero 428 ENDIF 429 survive(j) = ( un - reduct ) 430 431 ENDIF ! tree or grass 432 433 ENDIF ! pft there and natural 434 435 ENDDO ! loop over pfts 436 437 !SZ 438 !!$ ELSE 439 !!$ 440 !!$ ! 441 !!$ ! 3.2.2 not too much wood so that grasses can subsist 442 !!$ ! 443 !!$ 444 !!$ ! new total grass fpc 445 !!$ sumfpc_grass2 = fpc_crit - sumfpc_wood 446 !!$ 447 !!$ DO j = 2,nvm 448 !!$ 449 !!$ ! only present and natural PFTs compete 450 !!$ 451 !!$ IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 452 !!$ 453 !!$ IF ( tree(j) ) THEN 454 !!$ 455 !!$ ! no change for trees 456 !!$ 457 !!$ survive(j) = 1.0 458 !!$ 459 !!$ ELSE 460 !!$ 461 !!$ ! grass: fractional loss is the same for all grasses 462 !!$ 463 !!$ IF ( sumfpc_grass .GT. min_stomate ) THEN 464 !!$ survive(j) = sumfpc_grass2 / sumfpc_grass 465 !!$ ELSE 466 !!$ survive(j)= zero 467 !!$ ENDIF 468 !!$ 469 !!$ ENDIF 470 !!$ 471 !!$ ENDIF ! pft there and natural 472 !!$ 473 !!$ ENDDO ! loop over pfts 474 !!$ 475 !!$ ENDIF ! sumfpc_wood > fpc_crit 476 477 ! 478 ! 3.3 update output variables 479 ! 480 309 481 DO j = 2,nvm 310 311 ! only present and natural pfts compete 312 482 313 483 IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 314 315 IF ( tree(j) ) THEN316 317 !318 ! 3.2.1.1 tree319 !320 321 IF ( maxfpc_wood .GE. fpc_crit ) THEN322 323 ! 3.2.1.1.1 one single woody pft is overwhelming324 325 IF ( j .eq. optpft_wood ) THEN326 327 ! reduction for this dominant pft328 329 reduct = 1. - fpc_crit / fpc_nat(i,j)330 331 ELSE332 333 ! strongly reduce all other woody pfts334 ! (original DGVM: tree_mercy = 0.0 )335 336 reduct = 1. - tree_mercy337 338 ENDIF ! pft = dominant woody pft339 340 ELSE341 342 ! 3.2.1.1.2 no single woody pft is overwhelming343 ! (original DGVM: tree_mercy = 0.0 )344 ! The reduction rate is proportional to the ratio deltafpc/fpc.345 346 IF ( fpc_nat(i,j) .GE. min_stomate ) THEN347 348 reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &349 (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &350 ( un - tree_mercy ) )351 352 ELSE353 354 ! tree fpc didn't icrease or it started from nothing355 356 reduct = 0.357 358 ENDIF359 360 ENDIF ! maxfpc_wood > fpc_crit361 362 survive(j) = 1. - reduct363 484 485 bm_to_litter(i,j,:) = bm_to_litter(i,j,:) + & 486 biomass(i,j,:) * ( un - survive(j) ) 487 488 biomass(i,j,:) = biomass(i,j,:) * survive(j) 489 490 IF ( control%ok_dgvm ) THEN 491 ind(i,j) = ind(i,j) * survive(j) 492 ENDIF 493 494 ! fraction of plants that dies each day. 495 ! exact formulation: light_death(i,j) = 1. - survive(j) ** (1/dt) 496 light_death(i,j) = ( un - survive(j) ) / dt 497 498 ENDIF ! pft there and natural 499 500 ENDDO ! loop over pfts 501 502 ENDIF ! sumfpc > fpc_crit 503 504 ENDDO ! loop over grid points 505 506 ! 507 ! 4 recalculate fpc on natural part of grid cell (for next light competition) 508 ! 509 510 DO j = 2,nvm 511 512 IF ( natural(j) ) THEN 513 514 ! 515 ! 4.1 natural PFTs 516 ! 517 518 IF ( tree(j) ) THEN 519 520 ! 4.1.1 trees: minimum cover due to stems, branches etc. 521 522 DO i = 1, npts 523 !NVMODIF 524 ! IF (lai(i,j) == val_exp) THEN 525 ! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 526 ! ELSE 527 ! veget_lastlight(i,j) = & 528 ! cn_ind(i,j) * ind(i,j) * & 529 ! MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 530 ! ENDIF 531 !! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 532 IF (lai(i,j) == val_exp) THEN 533 veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 364 534 ELSE 365 366 ! 367 ! 3.2.1.2 grass: let a very small fraction survive (the sum of all 368 ! grass individuals may make up a maximum cover of 369 ! grass_mercy [for lai -> infinity]). 370 ! In the original DGVM, grasses were killed in that case, 371 ! corresponding to grass_mercy = 0. 372 ! 373 374 survive(j) = ( grass_mercy / REAL( num_grass,r_std ) ) / ind(i,j) 375 376 survive(j) = MIN( un, survive(j) ) 377 378 ENDIF ! tree or grass 379 380 ENDIF ! pft there and natural 381 382 ENDDO ! loop over pfts 383 535 veget_lastlight(i,j) = & 536 cn_ind(i,j) * ind(i,j) * & 537 MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover ) 538 ENDIF 539 ENDDO 540 541 ELSE 542 543 ! 4.1.2 grasses 544 DO i = 1, npts 545 !NVMODIF 546 ! IF (lai(i,j) == val_exp) THEN 547 ! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 548 ! ELSE 549 ! veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & 550 ! ( un - exp( -lai(i,j) * ext_coeff(j) ) ) 551 ! ENDIF 552 !!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 553 IF (lai(i,j) == val_exp) THEN 554 veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 555 ELSE 556 veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & 557 ( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ) 558 ENDIF 559 ENDDO 560 ENDIF ! tree/grass 561 384 562 ELSE 385 386 ! 387 ! 3.2.2 not too much wood so that grasses can subsist 388 ! 389 390 ! new total grass fpc 391 sumfpc_grass2 = fpc_crit - sumfpc_wood 392 393 DO j = 2,nvm 394 395 ! only present and natural PFTs compete 396 397 IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 398 399 IF ( tree(j) ) THEN 400 401 ! no change for trees 402 403 survive(j) = 1.0 404 405 ELSE 406 407 ! grass: fractional loss is the same for all grasses 408 409 IF ( sumfpc_grass .GT. min_stomate ) THEN 410 survive(j) = sumfpc_grass2 / sumfpc_grass 411 ELSE 412 survive(j)= 0.0 413 ENDIF 414 415 ENDIF 416 417 ENDIF ! pft there and natural 418 419 ENDDO ! loop over pfts 420 421 ENDIF ! sumfpc_wood > fpc_crit 422 423 ! 424 ! 3.3 update output variables 425 ! 426 427 DO j = 2,nvm 428 429 IF ( PFTpresent(i,j) .AND. natural(j) ) THEN 430 431 bm_to_litter(i,j,:) = bm_to_litter(i,j,:) + & 432 biomass(i,j,:) * ( 1. - survive(j) ) 433 434 biomass(i,j,:) = biomass(i,j,:) * survive(j) 435 436 IF ( control%ok_dgvm ) THEN 437 ind(i,j) = ind(i,j) * survive(j) 438 ENDIF 439 440 ! fraction of plants that dies each day. 441 ! exact formulation: light_death(i,j) = 1. - survive(j) ** (1/dt) 442 light_death(i,j) = ( 1. - survive(j) ) / dt 443 444 ENDIF ! pft there and natural 445 446 ENDDO ! loop over pfts 447 448 ENDIF ! sumfpc > fpc_crit 449 450 ENDDO ! loop over grid points 451 452 ! 453 ! 4 recalculate fpc on natural part of grid cell (for next light competition) 454 ! 455 456 DO j = 2,nvm 457 458 IF ( natural(j) ) THEN 459 460 ! 461 ! 4.1 natural PFTs 462 ! 463 464 IF ( tree(j) ) THEN 465 466 ! 4.1.1 trees: minimum cover due to stems, branches etc. 467 468 DO i = 1, npts 469 IF (lai(i,j) == val_exp) THEN 470 veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 471 ELSE 472 veget_lastlight(i,j) = & 473 cn_ind(i,j) * ind(i,j) * & 474 MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover ) 475 ENDIF 563 564 ! 565 ! 4.2 agricultural PFTs: not present on natural part 566 ! 567 568 veget_lastlight(:,j) = zero 569 570 ENDIF ! natural/agricultural 571 572 ENDDO 573 574 ELSE ! static 575 576 light_death(:,:) = zero 577 578 DO j = 2, nvm 579 580 IF ( natural(j) ) THEN 581 582 ! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses, 583 ! neither a redistribution of mortality (delta fpc) 584 585 WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate ) 586 lai_ind(:)=sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) ) 587 ELSEWHERE 588 lai_ind(:)=zero 589 ENDWHERE 590 591 fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) * & 592 MAX( ( 1._r_std - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) 593 594 WHERE(fpc_nat(:,j).GT.fpc_max(:,j)) 595 596 light_death(:,j)=MIN(un,un-fpc_max(:,j)/fpc_nat(:,j)) 597 598 ENDWHERE 599 600 DO k=1,nparts 601 602 bm_to_litter(:,j,k)=bm_to_litter(:,j,k)+light_death(:,j)*biomass(:,j,k) 603 biomass(:,j,k)=biomass(:,j,k)-light_death(:,j)*biomass(:,j,k) 604 476 605 ENDDO 477 478 ELSE 479 480 ! 4.1.2 grasses 481 DO i = 1, npts 482 IF (lai(i,j) == val_exp) THEN 483 veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 484 ELSE 485 veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * & 486 ( 1. - exp( -lai(i,j) * ext_coeff(j) ) ) 487 ENDIF 488 ENDDO 489 ENDIF ! tree/grass 490 491 ELSE 492 493 ! 494 ! 4.2 agricultural PFTs: not present on natural part 495 ! 496 497 veget_lastlight(:,j) = 0.0 498 499 ENDIF ! natural/agricultural 500 501 ENDDO 502 606 ind(:,j)=ind(:,j)-light_death(:,j)*ind(:,j) 607 ! if (j==10) print *,'ind10bis=',ind(:,j),light_death(:,j)*ind(:,j) 608 ENDIF 609 ENDDO 610 611 light_death(:,:)=light_death(:,:)/dt 612 613 ENDIF 614 503 615 ! 504 616 ! 5 history 505 617 ! 506 618 507 619 CALL histwrite (hist_id_stomate, 'LIGHT_DEATH', itime, & 508 620 light_death, npts*nvm, horipft_index) 509 621 510 622 IF (bavard.GE.4) WRITE(numout,*) 'Leaving light' 511 623 512 624 END SUBROUTINE light 513 625 514 626 END MODULE lpj_light
Note: See TracChangeset
for help on using the changeset viewer.
