- Timestamp:
- 2011-09-09T11:58:49+02:00 (13 years ago)
- Location:
- branches/ORCHIDEE_EXT/ORCHIDEE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/routing.f90
r407 r464 550 550 ! 551 551 ALLOCATE (routing_area_loc(nbpt,nbasmax)) 552 ALLOCATE (routing_area_glo(nbp_glo,nbasmax)) 552 !!$ ALLOCATE (routing_area_glo(nbp_glo,nbasmax)) 553 IF (is_root_prc) THEN 554 ALLOCATE (routing_area_glo(nbp_glo,nbasmax)) 555 ELSE 556 ALLOCATE (routing_area_glo(1,1)) 557 ENDIF 553 558 var_name = 'routingarea' 554 559 IF (is_root_prc) THEN … … 563 568 ! 564 569 ALLOCATE (route_togrid_loc(nbpt,nbasmax)) 565 ALLOCATE (route_togrid_glo(nbp_glo,nbasmax)) ! used in global in routing_flow 570 !!$ ALLOCATE (route_togrid_glo(nbp_glo,nbasmax)) ! used in global in routing_flow 571 IF (is_root_prc) THEN 572 ALLOCATE (route_togrid_glo(nbp_glo,nbasmax)) 573 ELSE 574 ALLOCATE (route_togrid_glo(1,1)) 575 ENDIF 566 576 IF (is_root_prc) THEN 567 577 var_name = 'routetogrid' … … 572 582 WHERE ( tmp_real_g .LT. val_exp ) 573 583 route_togrid_glo = NINT(tmp_real_g) 574 ENDWHERE584 ENDWHERE 575 585 ENDIF 576 586 CALL bcast(route_togrid_glo) ! used in global in routing_flow -
branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_light.f90
r387 r464 126 126 REAL(r_std), DIMENSION(npts) :: lai_ind 127 127 ! number of grass PFTs present in the grid box 128 ! INTEGER(i_std) :: num_grass128 ! INTEGER(i_std) :: num_grass 129 129 ! New total grass fpc 130 130 REAL(r_std) :: sumfpc_grass2 … … 338 338 ELSE 339 339 340 ! grasses341 342 ! total (natural) grass fpc343 344 sumfpc_grass = sumfpc_grass + fpc_nat(i,j)345 346 ! number of grass PFTs present in the grid box347 348 ! IF ( PFTpresent(i,j) ) THEN349 ! num_grass = num_grass + 1350 ! ENDIF351 352 ENDIF ! tree or grass353 354 ENDIF ! natural355 356 ENDDO ! loop over pfts357 358 !359 ! 3.2 light competition: assume wood outcompetes grass360 !361 !SZ340 ! grasses 341 342 ! total (natural) grass fpc 343 344 sumfpc_grass = sumfpc_grass + fpc_nat(i,j) 345 346 ! number of grass PFTs present in the grid box 347 348 ! IF ( PFTpresent(i,j) ) THEN 349 ! num_grass = num_grass + 1 350 ! ENDIF 351 352 ENDIF ! tree or grass 353 354 ENDIF ! natural 355 356 ENDDO ! loop over pfts 357 358 ! 359 ! 3.2 light competition: assume wood outcompetes grass 360 ! 361 !SZ 362 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 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 396 406 ELSE 397 407 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 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 438 !!$ ELSE 439 439 !!$ … … 493 493 494 494 ! fraction of plants that dies each day. 495 ! exact formulation: light_death(i,j) = 1. - survive(j) ** (1/dt)495 ! exact formulation: light_death(i,j) = 1. - survive(j) / dt 496 496 light_death(i,j) = ( un - survive(j) ) / dt 497 497
Note: See TracChangeset
for help on using the changeset viewer.