Changeset 486 for LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F

Timestamp:

Dec 15, 2003, 6:50:41 PM (20 years ago)

Author:

lmdzadmin

Message:

Phasage avec la version de Ionela
IM/LF

File:

• LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F (modified) (8 diffs)

LMDZ.3.3/branches/rel-LF/libf/phylmd/newmicro.F

@@ -1 +1 @@
       SUBROUTINE newmicro (paprs, pplay,ok_newmicro,
      .                  t, pqlwp, pclc, pcltau, pclemi,
-     .                  pch, pcl, pcm, pct, pctlwp)
+cIM    .                  pch, pcl, pcm, pct, pctlwp)
+     .                  pch, pcl, pcm, pct, pctlwp,
+     .                  xflwp, xfiwp, xflwc, xfiwc)
+
       IMPLICIT none
 c======================================================================
@@ -36 +39 @@
 C
       INTEGER i, k
-      REAL zflwp, zradef, zfice, zmsac
+cIM: 091003   REAL zflwp, zradef, zfice, zmsac
+      REAL zflwp(klon), zradef, zfice, zmsac
+cIM: 091003 rajout
+      REAL xflwp(klon), xfiwp(klon)
+      REAL xflwc(klon,klev), xfiwc(klon,klev)
 c
       REAL radius, rad_chaud
@@ -53 +60 @@
       logical ok_newmicro
 c     parameter (ok_newmicro=.FALSE.)
-      real rel, tc, rei, zfiwp
+cIM: 091003   real rel, tc, rei, zfiwp
+      real rel, tc, rei, zfiwp(klon)
       real k_liq, k_ice0, k_ice, DF
       parameter (k_liq=0.0903, k_ice0=0.005) ! units=m2/g
@@ -62 +70 @@
 c Calculer l'epaisseur optique et l'emmissivite des nuages
 c
+cIM inversion des DO
+      DO i = 1, klon
+       xflwp(i)=0.
+       xfiwp(i)=0.
       DO k = 1, klev
-      DO i = 1, klon
+c
+       xflwc(i,k)=0.
+       xfiwc(i,k)=0.
+c
          rad_chaud = rad_chau1
          IF (k.LE.3) rad_chaud = rad_chau2
          pclc(i,k) = MAX(pclc(i,k), seuil_neb)
-         zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
+         zflwp(i) = 1000.*pqlwp(i,k)/RG/pclc(i,k)
      .          *(paprs(i,k)-paprs(i,k+1))
          zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
@@ -74 +89 @@
          radius = rad_chaud * (1.-zfice) + rad_froid * zfice
          coef = coef_chau * (1.-zfice) + coef_froi * zfice
-         pcltau(i,k) = 3.0/2.0 * zflwp / radius
-         pclemi(i,k) = 1.0 - EXP( - coef * zflwp)
+         pcltau(i,k) = 3.0/2.0 * zflwp(i) / radius
+         pclemi(i,k) = 1.0 - EXP( - coef * zflwp(i))
 
          if (ok_newmicro) then
@@ -84 +99 @@
          zfice = MIN(MAX(zfice,0.0),1.0)
 
-         zflwp = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
-     :          *(paprs(i,k)-paprs(i,k+1))/RG
-         zfiwp = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
-     :          *(paprs(i,k)-paprs(i,k+1))/RG
+         zflwp(i) = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
+     :          *(paprs(i,k)-paprs(i,k+1))/RG
+         zfiwp(i) = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
+     :          *(paprs(i,k)-paprs(i,k+1))/RG
+
+         xflwp(i) = xflwp(i)+ (1.-zfice)*pqlwp(i,k)
+     :          *(paprs(i,k)-paprs(i,k+1))/RG
+         xfiwp(i) = xfiwp(i)+ zfice*pqlwp(i,k)
+     :          *(paprs(i,k)-paprs(i,k+1))/RG
+
+cIM Total Liquid/Ice water content
+         xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)
+         xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)
+cIM In-Cloud Liquid/Ice water content
+c        xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)/pclc(i,k)
+c        xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)/pclc(i,k)
 
 c -- effective cloud droplet radius (microns):
@@ -107 +134 @@
 c  for ice clouds, Ebert & Curry (1992)] 
 
-         if (zflwp.eq.0.) rel = 1. 
-         if (zfiwp.eq.0. .or. rei.le.0.) rei = 1. 
-         pcltau(i,k) = 3.0/2.0 * ( zflwp/rel )
-     .             + zfiwp * (3.448e-03  + 2.431/rei)
+         if (zflwp(i).eq.0.) rel = 1. 
+         if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1. 
+         pcltau(i,k) = 3.0/2.0 * ( zflwp(i)/rel )
+     .             + zfiwp(i) * (3.448e-03  + 2.431/rei)
 
 c -- cloud infrared emissivity:
@@ -121 +148 @@
 
          pclemi(i,k) = 1.0
-     .      - EXP( - coef_chau*zflwp - DF*k_ice*zfiwp )
+     .      - EXP( - coef_chau*zflwp(i) - DF*k_ice*zfiwp(i) )
 
          endif ! ok_newmicro