Changeset 1522 for LMDZ4/branches/LMDZ4_AR5

Timestamp:

May 24, 2011, 4:50:59 PM (14 years ago)

Author:

idelkadi

Message:

Correction du diagnostique utilise pour le calcul des fractions de nuages bas, moyens et haut

File:

• LMDZ4/branches/LMDZ4_AR5/libf/phylmd/newmicro.F (modified) (9 diffs)

LMDZ4/branches/LMDZ4_AR5/libf/phylmd/newmicro.F

@@ -1 +1 @@
 ! $Id$
+
+
+
 !     
       SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
@@ -51 +54 @@
 #include "radopt.h"
 c choix de l'hypothese de recouvrememnt nuageuse
-      LOGICAL RANDOM,MAXIMUM_RANDOM,MAXIMUM,FIRST
+      LOGICAL RANDOM,MAXIMUM_RANDOM,MAXIMUM
       parameter (RANDOM=.FALSE., MAXIMUM_RANDOM=.TRUE., MAXIMUM=.FALSE.)
+      LOGICAL, SAVE :: FIRST=.TRUE.
+!$OMP THREADPRIVATE(FIRST)
 c Hypoyhese de recouvrement : MAXIMUM_RANDOM
       INTEGER flag_max
@@ -76 +81 @@
       LOGICAL lo
 c
-      REAL cetahb, cetamb
-      PARAMETER (cetahb = 0.45, cetamb = 0.80)
+!!Abderr modif JL mail du 19.01.2011 18:31
+!      REAL cetahb, cetamb
+!      PARAMETER (cetahb = 0.45, cetamb = 0.80)
+! Remplacer
+!cetahb*paprs(i,1) par  prmhc
+!cetamb*paprs(i,1) par  prlmc 
+      REAL prmhc    ! Pressure between medium and high level cloud
+      REAL prlmc    ! Pressure between low and medium level cloud
+      PARAMETER (prmhc = 440.*100., prlmc = 680.*100.)
+
 C
       INTEGER i, k
@@ -129 +142 @@
       REAL zclear(klon)
       REAL zcloud(klon) 
+      REAL zcloudh(klon) 
+      REAL zcloudm(klon) 
+      REAL zcloudl(klon) 
+
 
 c **************************
@@ -421 +438 @@
          zclear(i)=1.
          zcloud(i)=0.
+         zcloudh(i)=0.
+         zcloudm(i)=0.
+         zcloudl(i)=0.
          pch(i)=1.0
          pcm(i) = 1.0
@@ -441 +461 @@
      &              /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
                pct(i)=1.-zclear(i) 
-               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
-                  pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloud(i)))
-     &                 /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
-               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
-     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN
-                  pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloud(i)))
-     &                 /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
-               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN 
-                  pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloud(i)))
-     &                 /(1.-MIN(real(zcloud(i), kind=8),1.-ZEPSEC))
+               IF (paprs(i,k).LT.prmhc) THEN
+                  pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloudh(i)))
+     &                 /(1.-MIN(real(zcloudh(i), kind=8),1.-ZEPSEC))
+                  zcloudh(i)=pclc(i,k)
+               ELSE IF (paprs(i,k).GE.prmhc .AND.
+     &                 paprs(i,k).LT.prlmc) THEN
+                  pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloudm(i)))
+     &                 /(1.-MIN(real(zcloudm(i), kind=8),1.-ZEPSEC))
+                  zcloudm(i)=pclc(i,k)
+               ELSE IF (paprs(i,k).GE.prlmc) THEN 
+                  pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloudl(i)))
+     &                 /(1.-MIN(real(zcloudl(i), kind=8),1.-ZEPSEC))
+                  zcloudl(i)=pclc(i,k)
                endif
                zcloud(i)=pclc(i,k)
@@ -460 +483 @@
                zcloud(i)=MAX(pclc(i,k),zcloud(i))
                pct(i)=zcloud(i)
-               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
+               IF (paprs(i,k).LT.prmhc) THEN
                   pch(i) = MIN(pclc(i,k),pch(i))
-               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
-     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN
+               ELSE IF (paprs(i,k).GE.prmhc .AND.
+     &                 paprs(i,k).LT.prlmc) THEN
                   pcm(i) = MIN(pclc(i,k),pcm(i))
-               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN
+               ELSE IF (paprs(i,k).GE.prlmc) THEN
                   pcl(i) = MIN(pclc(i,k),pcl(i))
                endif
@@ -475 +498 @@
                zclear(i)=zclear(i)*(1.-pclc(i,k))
                pct(i)=1-zclear(i)
-               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
+               IF (paprs(i,k).LT.prmhc) THEN
                   pch(i) = pch(i)*(1.0-pclc(i,k))
-               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
-     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN 
+               ELSE IF (paprs(i,k).GE.prmhc .AND.
+     &                 paprs(i,k).LT.prlmc) THEN 
                   pcm(i) = pcm(i)*(1.0-pclc(i,k))
-               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN
+               ELSE IF (paprs(i,k).GE.prlmc) THEN
                   pcl(i) = pcl(i)*(1.0-pclc(i,k))
                endif
@@ -526 +549 @@
             ENDDO
      
-            FIRST=.TRUE.
 
             DO i=1,klon