Changeset 257 for branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_gap.f90

Timestamp:

2011-06-17T14:02:17+02:00 (13 years ago)

Author:

didier.solyga

Message:

Externalized version merged with the trunk

File:

• branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_gap.f90 (modified) (9 diffs)

branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/lpj_gap.f90

@@ -39 +39 @@
   SUBROUTINE gap (npts, dt, &
        npp_longterm, turnover_longterm, lm_lastyearmax, &
-       PFTpresent, biomass, ind, bm_to_litter)
+       PFTpresent, biomass, ind, bm_to_litter, mortality)
 
     !
@@ -68 +68 @@
     ! biomass taken away (gC/(m**2 of ground))
     REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)  :: bm_to_litter
+    ! mortality (fraction of trees that is dying per time step), per day in history file
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)             :: mortality
 
     ! 0.3 local
 
-    ! which kind of mortality
-    LOGICAL, SAVE                                           :: constant_mortality
     ! biomass increase
     REAL(r_std), DIMENSION(npts)                             :: delta_biomass
+    ! biomass increase
+    REAL(r_std), DIMENSION(npts)                             :: dmortality
     ! vigour
     REAL(r_std), DIMENSION(npts)                             :: vigour
     ! natural availability, based on vigour
     REAL(r_std), DIMENSION(npts)                             :: availability
-    ! mortality (fraction of trees that is dying per time step), per day in history file
-    REAL(r_std), DIMENSION(npts,nvm)                        :: mortality
     ! indices
-    INTEGER(i_std)                                           :: j,k
+    INTEGER(i_std)                                           :: j,k,m
+    REAL(r_std) :: ref_greff
 
     ! =========================================================================
@@ -90 +91 @@
        firstcall = .FALSE.
 
-       !Config  Key  = LPJ_GAP_CONST_MORT
-       !Config  Desc = constant tree mortality
-       !Config  Def  = y
-       !Config  Help = If yes, then a constant mortality is applied to trees. 
-       !Config         Otherwise, mortality is a function of the trees' 
-       !Config         vigour (as in LPJ).
-
-       constant_mortality = .TRUE.
-       CALL getin_p('LPJ_GAP_CONST_MORT', constant_mortality)     
-       WRITE(numout,*) 'gap: constant mortality:', constant_mortality
-
     ENDIF
 
-    IF (bavard.GE.3) WRITE(numout,*) 'Entering gap'
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering gap',lpj_gap_const_mort
 
     mortality(:,:) = zero
 
+    ref_greff =  0.035
+
     DO j = 2,nvm
 
@@ -117 +109 @@
           !
 
-          IF ( .NOT. constant_mortality ) THEN
+          IF ( .NOT.  lpj_gap_const_mort  ) THEN
 
              !
@@ -125 +117 @@
              WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) )
 
+!SZ 080806, changed to LPJ formulation according to Smith et al., 2001 
+
                 ! how much did the tree grow per year?
 
-                delta_biomass(:) = &
-                     MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + &
-                     turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) ), &
-                     zero )
+!!$                delta_biomass(:) = &
+!!$                     MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + &
+!!$                     turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) ), &
+!!$                     0._r_std )
+
+            ! note that npp_longterm is now actually longterm growth efficiency (NPP/LAI)
+            ! to be fair to deciduous trees
+             delta_biomass(:) = MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf) + &
+                  turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) + & 
+                  turnover_longterm(:,j,isapabove) + turnover_longterm(:,j,isapbelow) ) ,zero)
 
                 ! scale this to the leaf surface of the tree
-
-                vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j)) / vigour_coeff
+!!$                vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j)) / vigour_coeff
+             vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j))
 
              ELSEWHERE
@@ -147 +147 @@
                 ! low vigour.
 
-                availability(:) = availability_fact / ( 1.+vigour(:)/vigour_ref)
+!SZ 080806, changed to LPJ formulation according to Smith et al., 2001 
+! tuned maximal mortality to 0.05 to get realistic range of avergage age to get ~100 years at GREFF=100
+! for the range of modelled annual NPP
+!!$                availability(:) = min_avail / ( 1.+vigour(:)/vigour_ref )
+                availability(:) = 0.1 / ( 1.+ref_greff*vigour(:) )
 
                 ! Mortality (fraction per time step).
@@ -158 +162 @@
                 ! approximation ok as availability < 0.02 << 1
 
-                mortality(:,j) = availability(:) * dt/one_year
+                mortality(:,j) = MAX(min_avail,availability(:))  * dt/one_year  
+!!$                mortality(:,j) = availability(:) * dt/one_year
 
              ENDWHERE
@@ -199 +204 @@
              WHERE ( PFTpresent(:,j) )
 
-                bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + mortality(:,j) * biomass(:,j,k)
-
-                biomass(:,j,k) = biomass(:,j,k) * ( 1. - mortality(:,j) )
+                dmortality(:) =  mortality(:,j) * biomass(:,j,k)
+                bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + dmortality(:)
+                
+                biomass(:,j,k) = biomass(:,j,k) - dmortality(:)
 
              ENDWHERE
@@ -211 +217 @@
           !
 
-          IF ( control%ok_dgvm ) THEN
-
-             WHERE ( PFTpresent(:,j) )
-
-                ind(:,j) = ind(:,j) * ( 1. - mortality(:,j) )
-
-             ENDWHERE
-
+!SZ 080806, allow changing density in static case when mortality is dynamic
+          IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+
+             WHERE ( PFTpresent(:,j) )
+
+                ind(:,j) = ind(:,j) * ( un - mortality(:,j) )
+
+             ENDWHERE
+
+          ENDIF
+
+       ELSE 
+
+          IF ( .NOT.control%ok_dgvm .AND. .NOT.lpj_gap_const_mort) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. 10. ) )
+
+                mortality(:,j) = 1.
+
+             ENDWHERE
+             DO k = 1, nparts
+
+                WHERE ( PFTpresent(:,j) )
+
+                   dmortality(:) =  mortality(:,j) * biomass(:,j,k)
+                   
+                   bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + dmortality(:)
+                   
+                   biomass(:,j,k) = biomass(:,j,k) - dmortality(:)
+
+                ENDWHERE
+             ENDDO
+             
           ENDIF