Changeset 257 for branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_alloc.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/stomate_alloc.f90 (modified) (13 diffs)

branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_alloc.f90

@@ -162 +162 @@
        ! 1.1.1 soil levels
 
-       z_soil(0) = 0.
+       z_soil(0) = zero
        z_soil(1:nbdl) = diaglev(1:nbdl)
 
@@ -202 +202 @@
     !
 
-    f_alloc(:,:,:) = 0.0
-    f_alloc(:,:,icarbres) = 1.0
+    f_alloc(:,:,:) = zero
+    f_alloc(:,:,icarbres) = un
     !
     ! 1.3 Convolution of the temperature and humidity profiles with some kind of profile
@@ -212 +212 @@
 
     ! 1.3.1.1 rpc is an integration constant such that the integral of the root profile is 1.
-    rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
+    rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_nitrogen ) )
 
     ! 1.3.1.2 integrate over the nbdl levels
@@ -229 +229 @@
 
     ! 1.3.2.1 rpc is an integration constant such that the integral of the root profile is 1.
-    rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
+    rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_nitrogen ) )
 
     ! 1.3.2.2 integrate over the nbdl levels
 
-    h_nitrogen(:) = 0.0
+    h_nitrogen(:) = zero
 
     DO l = 1, nbdl
@@ -251 +251 @@
     ! mean LAI on natural part
 
-    natveg_tot(:) = 0.0
-    lai_nat(:) = 0.0
+    natveg_tot(:) = zero
+    lai_nat(:) = zero
 
     DO j = 2, nvm
@@ -259 +259 @@
           veget_max_nat(:,j) = veget_max(:,j)
        ELSE
-          veget_max_nat(:,j) = 0.0
+          veget_max_nat(:,j) = zero
        ENDIF
 
@@ -314 +314 @@
        !             3/ must be at the beginning of the growing season
 
-       WHERE ( ( biomass(:,j,ileaf) .GT. 0.0 ) .AND. & 
+       WHERE ( ( biomass(:,j,ileaf) .GT. zero ) .AND. & 
             ( .NOT. senescence(:,j) ) .AND. &
             ( lai(:,j) .LT. lai_happy(j) ) .AND. &
@@ -337 +337 @@
        ELSEWHERE
 
-          transloc_leaf(:) = 0.0
+          transloc_leaf(:) = zero
 
        ENDWHERE
@@ -468 +468 @@
           ! leaf allocation
 
-          LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:)
+          LtoLSR(:) = un - RtoLSR(:) - StoLSR(:)
           LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
 
           ! roots: the rest
 
-          RtoLSR(:) = 1. - LtoLSR(:) - StoLSR(:)
+          RtoLSR(:) = un - LtoLSR(:) - StoLSR(:)
 
        ENDWHERE
@@ -483 +483 @@
           StoLSR(:) = StoLSR(:) + LtoLSR(:)
 
-          LtoLSR(:) = 0.0
+          LtoLSR(:) = zero
 
        ENDWHERE
@@ -514 +514 @@
 
                 IF ( ( biomass(i,j,icarbres)*sla(j) ) .LT. 2*lai_max(j) ) THEN
-                   carb_rescale(i) = 1. / ( 1. + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
+                   carb_rescale(i) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
                 ELSE
-                   carb_rescale(i) = 1.
+                   carb_rescale(i) = un
                 ENDIF
 
@@ -522 +522 @@
 
                 f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
-                     ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i)
-                f_alloc(i,j,isapbelow) = StoLSR(i) * ( 1. - alloc_sap_above(i) ) * &
-                     ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
 
                 f_alloc(i,j,iroot) = RtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i)
@@ -530 +530 @@
                 ! this is equivalent to:
                 ! reserve alloc = ecureuil*(LtoLSR+StoLSR)*(1-fruit_alloc)*carb_rescale
-                f_alloc(i,j,icarbres) = ( 1. - carb_rescale(i) ) * ( 1.-f_alloc(i,j,ifruit) )
+                f_alloc(i,j,icarbres) = ( un - carb_rescale(i) ) * ( 1.-f_alloc(i,j,ifruit) )
 
              ENDIF  ! senescent?