Changeset 257 for branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/diffuco.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_sechiba/diffuco.f90 (modified) (14 diffs)

branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/diffuco.f90

@@ -3 +3 @@
 !!
 !! @author Marie-Alice Foujols and Jan Polcher
-!! @Version : $Revision: 1.35 $, $Date: 2010/04/07 09:16:40 $
+!! @Version : $Revision: 42 $, $Date: 2011-01-01 21:15:03 +0100 (Sat, 01 Jan 2011) $
 !! 
-!! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_sechiba/diffuco.f90,v 1.35 2010/04/07 09:16:40 ssipsl Exp $
+!< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/diffuco.f90 $
+!< $Date: 2011-01-01 21:15:03 +0100 (Sat, 01 Jan 2011) $
+!< $Author: mmaipsl $
+!< $Revision: 42 $
 !! IPSL (2006)
 !!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
@@ -38 +41 @@
   !! Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout
   !! d'un potentiometre pour regler la resistance de la vegetation ( rveg is now in pft_parameters)
-
   ! MM
   REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: wind                     !! Wind norm
@@ -242 +244 @@
     ! beta coefficient for bare soil
     !
-
     CALL diffuco_bare (kjpindex, dtradia, u, v, q_cdrag, rsol, evap_bare_lim, evapot, humrel, veget, vbeta4) 
 
@@ -744 +745 @@
                 IF ( zrapp .LT. un ) THEN
                    ! Ajout Nathalie - Juin 2006
-                    vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, 0.)
+                    vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, zero)
                     ! Fin ajout Nathalie
                     vbeta2(ji,jv) = vbeta2(ji,jv) * zrapp
@@ -1004 +1005 @@
     !
     DO jl = 1, nlai+1
-      laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))-1.)
+      laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))-un)
     ENDDO
     !
@@ -1100 +1101 @@
       !
       WHERE ( assimilate(:) )
-        water_lim(:) = MIN( 2.*humrel(:,jv), 1. )
+        water_lim(:) = MIN( 2.*humrel(:,jv), un )
       ENDWHERE
       ! give a default value of ci for all pixel that do not assimilate
@@ -1255 +1256 @@
           DO ji = 1, kjpindex
             !
-            assimi(ji) = 0.
+            assimi(ji) = zero
             !
           ENDDO
@@ -1288 +1289 @@
           DO ji = 1, kjpindex
             !
-            assimi(ji) = 0.
+            assimi(ji) = zero
             !
           ENDDO
@@ -1383 +1384 @@
         IF ( jl .EQ. 1 ) THEN
           !
-          leaf_gs_top(:) = 0.
+          leaf_gs_top(:) = zero
           !
           IF ( nic .GT. 0 ) then
@@ -1437 +1438 @@
               laitab(ilai(iainia)+1)
           !
-          rveget(iainia,jv) = 1./gstop(iainia)
+          rveget(iainia,jv) = un/gstop(iainia)
           !
         ENDDO
@@ -1448 +1449 @@
           !
           ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif
-          !rstruct(iainia,jv) = 1./gstot(iainia) - &
+          !rstruct(iainia,jv) = un/gstot(iainia) - &
           !     rveget(iainia,jv)
-          rstruct(iainia,jv) = MAX( 1./gstot(iainia) - &
+          rstruct(iainia,jv) = MAX( un/gstot(iainia) - &
                rveget(iainia,jv), min_sechiba)
           !
@@ -1556 +1557 @@
     REAL(r_std)                                    :: coeff_dew_veg
 
-    vbeta2sum(:) = 0.
-    vbeta3sum(:) = 0.
+    vbeta2sum(:) = zero
+    vbeta3sum(:) = zero
     DO jv = 1, nvm
       vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
@@ -1593 +1594 @@
 
     ! for vectorization: some arrays
-    vegetsum(:) = 0.
+    vegetsum(:) = zero
     DO jv = 1, nvm
       vegetsum(:) = vegetsum(:) + veget(:,jv)
     ENDDO
-    vegetsum2(:) = 0.
+    vegetsum2(:) = zero
     DO jv = 2, nvm
       vegetsum2(:) = vegetsum2(:) + veget(:,jv)
@@ -1667 +1668 @@
                          & + dew_veg_poly_coeff(2)*lai(ji,jv) &
                          & + dew_veg_poly_coeff(1)
-
-
                  ELSE
-                    coeff_dew_veg=1.
+                    coeff_dew_veg=un
                  ENDIF
               ELSE