Changeset 430

Timestamp:

2011-08-31T12:17:34+02:00 (13 years ago)

Author:

didier.solyga

Message:

Replace 0.0 by zero and the physical constants by the values used in constantes.f90

File:

• branches/ORCHIDEE_EXT/ORCHIDEE_OL/weather.f90 (modified) (24 diffs)

branches/ORCHIDEE_EXT/ORCHIDEE_OL/weather.f90

@@ -103 +103 @@
 ! 
   REAL,PARAMETER :: pir = pi/180.
-
+  REAL,PARAMETER ::  rair = 287.
 !-
 ! Parametres orbitaux:
@@ -217 +217 @@
 ! daily average temperature (K)
   REAL :: td(npoi)
-  REAL,PARAMETER ::  rair = 287.
+!!$  REAL,PARAMETER ::  rair = 287.
 !>> The two following parameters are replaced by the values used by ORCHIDEE in constantes.f90
   ! grav by cte_grav= 9.80665
@@ -288 +288 @@
       STOP 
     ENDIF
-    xstore(:,:) = 0.
+    xstore(:,:) = zero
     npoi0 = npoi
   ELSE IF (npoi /= npoi0) THEN
@@ -432 +432 @@
 !------ initialize daily precipitation to zero
 !-------
-        precip(i) = 0.0
+        precip(i) = zero
 !-------
         IF (xinprec(i,imonth) > 1.e-6) THEN
@@ -509 +509 @@
       CALL bcast(count_not_ok_g)
 !-
-      z(:)=0.0
+      z(:) = zero
       DO WHILE (count_not_ok_g > 0)
         IF (is_root_prc) THEN
@@ -520 +520 @@
         DO i=1,npoi
           IF ((iwet(i) == 1).AND.(not_ok(i) == 1)) then
-            IF ( (rn1-tr1(i)) <= 0. ) THEN
-              s1 = 0.0
+            IF ( (rn1-tr1(i)) <= zero ) THEN
+              s1 = zero
             ELSE
               s1 = rn1**aa(i)
             ENDIF
 !-----------
-            IF ((rn2-tr2(i)) <= 0.) THEN
-              s2 = 0.0
+            IF ((rn2-tr2(i)) <= zero) THEN
+              s2 = zero
             ELSE
               s2 = rn2**ab(i)
@@ -533 +533 @@
 !-----------
             s12 = s1+s2
-            IF ((s12-1.0) <= 0.) THEN
+            IF ((s12-1.0) <= zero) THEN
               z(i) = s1/s12
               not_ok(i) = 0
@@ -616 +616 @@
  &                   /REAL(NINT(MAX(1.,xinwet(i,imonth))))
         ELSE
-          precip(i) = 0.
+          precip(i) = zero
         ENDIF
       ENDDO
@@ -638 +638 @@
 !---- modify maximum temperatures for wet and dry days
 !-----
-      IF (pwet(i) /= 0.0) THEN
+      IF (pwet(i) /= zero) THEN
         tmaxd = tmaxm+pwet(i)*omtmax*trngm
         tmaxw = tmaxd-        omtmax*trngm
@@ -707 +707 @@
 !---- following logic of the EPIC weather generator code
 !-----
-      IF (pwet(i) /= 0.0) THEN
-        cloudd = (cloudm-pwet(i)*omcloud)/(1.0-pwet(i)*omcloud)
-        cloudd = MIN(1.0,MAX(0.0,cloudd))
-        cloudw = (cloudm-(1.0-pwet(i))*cloudd)/pwet(i)
+      IF (pwet(i) /= zero) THEN
+        cloudd = (cloudm-pwet(i)*omcloud)/(un-pwet(i)*omcloud)
+        cloudd = MIN(un,MAX(zero,cloudd))
+        cloudw = (cloudm-(un-pwet(i))*cloudd)/pwet(i)
       ELSE
         cloudd = cloudm
@@ -758 +758 @@
 !-- zero out vectors
 !---
-    r(1:3)  = 0.0
-    rr(1:npoi,1:3) = 0.0
+    r(1:3)  = zero
+    rr(1:npoi,1:3) = zero
 !---
 !-- update working vectors
@@ -804 +804 @@
       cloud(i) = cloude(i)+clouds(i)*xstore(i,3)
 !---- constrain cloud cover to be between 0 and 100%
-      cloud(i) = MAX(0.0,MIN(1.0,cloud(i)))
+      cloud(i) = MAX(zero,MIN(un,cloud(i)))
     enddo
 !---
@@ -844 +844 @@
 !---- following logic of the EPIC weather generator code
 !-----
-      if (pwet(i) /= 0.0) then
-        qdd(i) = (qdm(i)-pwet(i)*omqd)/(1.0-pwet(i)*omqd)
+      if (pwet(i) /= zero) then
+        qdd(i) = (qdm(i)-pwet(i)*omqd)/(un-pwet(i)*omqd)
         if (qdd(i) < 0.2) then
           qdd(i) = 0.2
           if (qdd(i) > qdm(i)) qdm(i) = qdd(i)
         ENDIF
-        qdd(i) = MIN(1.0,qdd(i))
-        qdw(i) = (qdm(i)-(1.0-pwet(i))*qdd(i))/pwet(i)
+        qdd(i) = MIN(un,qdd(i))
+        qdw(i) = (qdm(i)-(un-pwet(i))*qdd(i))/pwet(i)
       ELSE
         qdd(i) = qdm(i)
@@ -864 +864 @@
 !-----
       xx = exp(qde(i))
-      qdup(i)  = qde(i)+(1.0-qde(i))*xx/e
-      qdlow(i) = qde(i)*(1.0-1./xx)
+      qdup(i)  = qde(i)+(un-qde(i))*xx/e
+      qdlow(i) = qde(i)*(un-1./xx)
 !-----
 !---- randomlly select humidity from triangular distribution function
@@ -1151 +1151 @@
 !-- calculate the cosine of the solar zenith angle
 !---
-    coszen(i) = MAX(0.0, (sin(xlat)*sin(xdecl) &
+    coszen(i) = MAX(zero, (sin(xlat)*sin(xdecl) &
  &                      + cos(xlat)*cos(xdecl)*cos(angle)))
 !---
@@ -1342 +1342 @@
 !-- the surface air temperature
 !---
-    dtair   = 0.0
-    dtcloud = 0.0
+    dtair   = zero
+    dtcloud = zero
 !---
 !-- total downward ir is equal to the sum of:
@@ -1360 +1360 @@
 !-- reset snow and rain to zero
 !---
-    snowa(i) = 0.0
-    raina(i) = 0.0
+    snowa(i) = zero
+    raina(i) = zero
 !---
 !-- if precipitation event then calculate
@@ -2223 +2223 @@
     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
     IF (ALL(xchamp_g(:) == val_exp)) THEN
-      xchamp_g(:) = 0.
+      xchamp_g(:) = zero
     ENDIF
   ENDIF
@@ -2378 +2378 @@
   qair(:,:)=val_exp
   pb(:,:)=val_exp
-  xx = 9.81/287./0.0065
+!!$  xx = 9.81/287./0.0065
+  xx = cte_grav/rair/0.0065
   DO ij=1,nbindex
      j = ((kindex(ij)-1)/iim) + 1
@@ -2757 +2758 @@
   swdown(:,:) = solad(:,:)+solai(:,:)
 !-
-  v(:) = 0.
+  v(:) = zero
 !-
 ! 5. Store date
@@ -3172 +3173 @@
       STOP 
     ENDIF
-    outside(:) = 0.
+    outside(:) = zero
     nb_outside = 0
     DO i=1,iimjjm
@@ -3277 +3278 @@
   REAL            :: tsat
 !---------------------------------------------------------------------
-  tsat = MIN(100.,MAX(t-zero_t,0.))
+  tsat = MIN(100.,MAX(t-zero_t,zero))
 !-----------------
 END FUNCTION tsatl
@@ -3292 +3293 @@
   REAL            :: tsat
 !---------------------------------------------------------------------
-  tsat = MAX(-60.,MIN(t-zero_t,0.))
+  tsat = MAX(-60.,MIN(t-zero_t,zero))
 !-----------------
 END FUNCTION tsati
@@ -3380 +3381 @@
   ENDWHERE
 !-
-  tl(:) = MIN(100.,MAX(t(:)-zero_t,0.))
-  ti(:) = MAX(-60.,MIN(t(:)-zero_t,0.))
+  tl(:) = MIN(100.,MAX(t(:)-zero_t,zero))
+  ti(:) = MAX(-60.,MIN(t(:)-zero_t,zero))
 !-
   e(:) =  100.* &