Changeset 464 for branches


Ignore:
Timestamp:
2011-09-09T11:58:49+02:00 (13 years ago)
Author:
didier.solyga
Message:

Corrections due to incorrect merge to the 1.9.5.2 version

Location:
branches/ORCHIDEE_EXT/ORCHIDEE
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/routing.f90

    r407 r464  
    550550    ! 
    551551    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 
    553558    var_name = 'routingarea' 
    554559    IF (is_root_prc) THEN 
     
    563568    ! 
    564569    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 
    566576    IF (is_root_prc) THEN 
    567577       var_name = 'routetogrid' 
     
    572582       WHERE ( tmp_real_g .LT. val_exp ) 
    573583          route_togrid_glo = NINT(tmp_real_g) 
    574     ENDWHERE 
     584       ENDWHERE 
    575585    ENDIF 
    576586    CALL bcast(route_togrid_glo)                      ! used in global in routing_flow 
  • branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_light.f90

    r387 r464  
    126126    REAL(r_std), DIMENSION(npts)                              :: lai_ind 
    127127    ! number of grass PFTs present in the grid box 
    128 !    INTEGER(i_std)                                            :: num_grass 
     128    !    INTEGER(i_std)                                            :: num_grass 
    129129    ! New total grass fpc 
    130130    REAL(r_std)                                               :: sumfpc_grass2 
     
    338338                   ELSE 
    339339                    
    340                    ! 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 
     340                      ! 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 
    362362!!$             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                    
    396406                   ELSE 
    397407                       
    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 
    438438!!$    ELSE 
    439439!!$        
     
    493493                    
    494494                   ! 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 
    496496                   light_death(i,j) = ( un - survive(j) ) / dt 
    497497                    
Note: See TracChangeset for help on using the changeset viewer.