Changeset 685 for LMDZ4/trunk/libf/phylmd

Timestamp:

Apr 4, 2006, 5:01:33 PM (18 years ago)

Author:

lmdzadmin

Message:

Prise en compte du type de recouvrement cf. CR
IM

File:

• LMDZ4/trunk/libf/phylmd/newmicro.F (modified) (4 diffs)

LMDZ4/trunk/libf/phylmd/newmicro.F

@@ -42 +42 @@
 #include "dimphy.h"
 #include "nuage.h"
+cIM cf. CR: include pour NOVLP et ZEPSEC
+#include "radepsi.h"
+#include "radopt.h"
       REAL paprs(klon,klev+1), pplay(klon,klev)
       REAL t(klon,klev)
@@ -103 +106 @@
       REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag
 cjq-end    
+cIM cf. CR:parametres supplementaires
+      REAL zclear(klon)
+      REAL zcloud(klon) 
 c
 c Calculer l'epaisseur optique et l'emmissivite des nuages
@@ -287 +293 @@
 C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
 C
-      DO i = 1, klon
-         pct(i)=1.0
+cIM cf. CR:test: calcul prenant ou non en compte le recouvrement
+cinitialisations
+      DO i=1,klon
+         zclear(i)=1.
+         zcloud(i)=0.
          pch(i)=1.0
          pcm(i) = 1.0
@@ -295 +304 @@
       ENDDO
 C
+cIM cf CR DO k=1,klev
       DO k = klev, 1, -1
       DO i = 1, klon
          pctlwp(i) = pctlwp(i) 
      .             + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
-         pct(i) = pct(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).LE.cetahb*paprs(i,1))
-     .      pch(i) = pch(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
-     .       pplay(i,k).LE.cetamb*paprs(i,1)) 
-     .      pcm(i) = pcm(i)*(1.0-pclc(i,k))
-         if (pplay(i,k).GT.cetamb*paprs(i,1))
-     .      pcl(i) = pcl(i)*(1.0-pclc(i,k))
-      ENDDO
+cIM cf. CR
+            IF (NOVLP.EQ.1) THEN
+               zclear(i)=zclear(i)*(1.-MAX(pclc(i,k),zcloud(i)))
+     s                            /(1.-MIN(zcloud(i),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)))
+     s                            /(1.-MIN(zcloud(i),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)))
+     s                            /(1.-MIN(zcloud(i),1.-ZEPSEC))
+               else if (pplay(i,k).GT.cetamb*paprs(i,1)) then 
+                  pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloud(i)))
+     s                            /(1.-MIN(zcloud(i),1.-ZEPSEC))
+               endif
+               zcloud(i)=pclc(i,k)
+            ELSE IF (NOVLP.EQ.2) THEN
+               zcloud(i)=MAX(pclc(i,k),zcloud(i))
+               pct(i)=zcloud(i)
+               if (pplay(i,k).LE.cetahb*paprs(i,1)) 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
+                  pcm(i) = MIN(pclc(i,k),pcm(i))
+               else if (pplay(i,k).GT.cetamb*paprs(i,1)) then
+                  pcl(i) = MIN(pclc(i,k),pcl(i))
+               endif
+            ELSE IF (NOVLP.EQ.3) THEN
+               zclear(i)=zclear(i)*(1.-pclc(i,k))
+               pct(i)=1-zclear(i)
+               if (pplay(i,k).LE.cetahb*paprs(i,1)) 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 
+               pcm(i) = pcm(i)*(1.0-pclc(i,k))
+               else if (pplay(i,k).GT.cetamb*paprs(i,1)) then
+               pcl(i) = pcl(i)*(1.0-pclc(i,k))
+               endif
+            ENDIF
+         ENDDO
       ENDDO
 C
       DO i = 1, klon
-         pct(i)=1.-pct(i)
+cIM cf. CR          pct(i)=1.-pct(i)
          pch(i)=1.-pch(i)
          pcm(i)=1.-pcm(i)