Index: LMDZ4/branches/LMDZ4-dev/libf/phylmd/calcul_STDlev.h
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/phylmd/calcul_STDlev.h	(revision 1089)
+++ LMDZ4/branches/LMDZ4-dev/libf/phylmd/calcul_STDlev.h	(revision 1090)
@@ -56,13 +56,102 @@
 cIM on interpole sur les niveaux STD de pression a chaque pas de temps de la physique
 c
-       DO k=1, nlevSTD
-c
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .              t_seri,tlevSTD(:,k))
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             u_seri,ulevSTD(:,k))
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             v_seri,vlevSTD(:,k))
-c
+c-------------------------------------------------------c
+c positionnement de l'argument logique a .false.        c
+c pour ne pas recalculer deux fois la meme chose !      c
+c a cet effet un appel a plevel_new a ete deplace       c
+c a la fin de la serie d'appels                         c
+c la boucle 'DO k=1, nlevSTD' a ete internalisee        c
+c dans plevel_new, d'ou la creation de cette routine... c
+c-------------------------------------------------------c
+c
+        CALL plevel_new(klon,klev,nlevSTD,.true.,pplay,rlevSTD,
+     &              t_seri,tlevSTD)
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             u_seri,ulevSTD)
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             v_seri,vlevSTD)
+c
+
+c
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zphi/RG,philevSTD)
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             qx(:,:,ivap),qlevSTD)
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_rh*100.,rhlevSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=u_seri(i,l)*v_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,uvSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=v_seri(i,l)*q_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,vqSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=v_seri(i,l)*t_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,vTSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=omega(i,l)*qx(i,l,ivap)
+         ENDDO !i 
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,wqSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=v_seri(i,l)*zphi(i,l)/RG
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,vphiSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=omega(i,l)*t_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,wTSTD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=u_seri(i,l)*u_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,u2STD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=v_seri(i,l)*v_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,v2STD)
+c
+        DO l=1, klev
+         DO i=1, klon
+          zx_tmp_fi3d(i,l)=t_seri(i,l)*t_seri(i,l)
+         ENDDO !i
+        ENDDO !l
+        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
+     &             zx_tmp_fi3d,T2STD)
+
+
         DO l=1, klev
         DO i=1, klon
@@ -70,87 +159,7 @@
         ENDDO !i
         ENDDO !l
-        CALL plevel(klon,klev,.true.,zx_tmp_fi3d,rlevSTD(k),
-     .             omega,wlevSTD(:,k))
-c
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zphi/RG,philevSTD(:,k))
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             qx(:,:,ivap),qlevSTD(:,k))
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_rh*100.,rhlevSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=u_seri(i,l)*v_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,uvSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*q_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,vqSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*t_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,vTSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=omega(i,l)*qx(i,l,ivap)
-         ENDDO !i 
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,wqSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*zphi(i,l)/RG
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,vphiSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=omega(i,l)*t_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,wTSTD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=u_seri(i,l)*u_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,u2STD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=v_seri(i,l)*v_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,v2STD(:,k))
-c
-        DO l=1, klev
-         DO i=1, klon
-          zx_tmp_fi3d(i,l)=t_seri(i,l)*t_seri(i,l)
-         ENDDO !i
-        ENDDO !l
-        CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
-     .             zx_tmp_fi3d,T2STD(:,k))
-c
-       ENDDO !k=1,nlevSTD
+        CALL plevel_new(klon,klev,nlevSTD,.true.,zx_tmp_fi3d,rlevSTD,
+     &             omega,wlevSTD)
+
 c
 cIM on somme les valeurs definies a chaque pas de temps de la physique ou 
Index: LMDZ4/branches/LMDZ4-dev/libf/phylmd/plevel_new.F
===================================================================
--- LMDZ4/branches/LMDZ4-dev/libf/phylmd/plevel_new.F	(revision 1090)
+++ LMDZ4/branches/LMDZ4-dev/libf/phylmd/plevel_new.F	(revision 1090)
@@ -0,0 +1,134 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/plevel.F,v 1.1.1.1.10.1 2006/08/17 15:41:51 fairhead Exp $
+!
+c================================================================
+c================================================================
+      SUBROUTINE plevel_new(ilon,ilev,klevSTD,lnew,pgcm,pres,Qgcm,Qpres)
+c================================================================
+c================================================================
+      USE dimphy
+      IMPLICIT none
+
+cym#include "dimensions.h"
+cy#include "dimphy.h"
+
+c================================================================
+c
+c Interpoler des champs 3-D u, v et g du modele a un niveau de
+c pression donnee (pres)
+c
+c INPUT:  ilon ----- nombre de points
+c         ilev ----- nombre de couches
+c         lnew ----- true si on doit reinitialiser les poids
+c         pgcm ----- pressions modeles
+c         pres ----- pression vers laquelle on interpolle
+c         Qgcm ----- champ GCM
+c         Qpres ---- champ interpolle au niveau pres
+c
+c================================================================
+c
+c   arguments :
+c   -----------
+
+      INTEGER ilon, ilev, klevSTD
+      logical lnew
+      
+      REAL pgcm(ilon,ilev)
+      REAL Qgcm(ilon,ilev)
+      real pres(klevSTD)
+      REAL Qpres(ilon, klevSTD)
+
+c   local :
+c   -------
+
+cym      INTEGER lt(klon), lb(klon)
+cym      REAL ptop, pbot, aist(klon), aisb(klon)
+
+cym      save lt,lb,ptop,pbot,aist,aisb
+      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:) :: lt,lb
+      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:,:) :: aist,aisb
+c$OMP THREADPRIVATE(lt,lb,aist,aisb)      
+      REAL,SAVE :: ptop, pbot
+c$OMP THREADPRIVATE(ptop, pbot)      
+      LOGICAL,SAVE :: first = .true.
+      INTEGER :: nlev
+c$OMP THREADPRIVATE(first)
+      INTEGER i, k
+c
+      if (first) then
+         allocate(lt(klon),lb(klon))
+         allocate(aist(klon,klevSTD),aisb(klon, klevSTD))
+         first=.false.
+      endif
+      
+c=====================================================================
+      if (lnew) then
+c   on reinitialise les reindicages et les poids
+c=====================================================================
+
+
+c Chercher les 2 couches les plus proches du niveau a obtenir
+c
+c Eventuellement, faire l'extrapolation a partir des deux couches
+c les plus basses ou les deux couches les plus hautes:
+c
+c
+         DO nlev = 1, klevSTD
+            DO i = 1, klon
+               IF ( ABS(pres(nlev)-pgcm(i,ilev) ) .LT.
+     &              ABS(pres(nlev)-pgcm(i,1)) ) THEN
+                  lt(i) = ilev  ! 2
+                  lb(i) = ilev-1 ! 1
+               ELSE
+                  lt(i) = 2
+                  lb(i) = 1
+               ENDIF
+            ENDDO
+            DO k = 1, ilev-1
+               DO i = 1, klon
+                  pbot = pgcm(i,k)
+                  ptop = pgcm(i,k+1)
+                  IF (ptop.LE.pres(nlev) .AND. pbot.GE.pres(nlev)) THEN
+                     lt(i) = k+1
+                     lb(i) = k
+                  ENDIF
+               ENDDO
+            ENDDO
+            
+c     Interpolation lineaire:
+            DO i = 1, klon
+c     interpolation en logarithme de pression:
+c     
+c     ...   Modif . P. Le Van    ( 20/01/98) ....
+c     Modif Frederic Hourdin (3/01/02)
+               
+               aist(i,nlev) = LOG( pgcm(i,lb(i))/ pres(nlev) )
+     &              / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)) )
+               aisb(i,nlev) = LOG( pres(nlev) / pgcm(i,lt(i)) )
+     &              / LOG( pgcm(i,lb(i))/ pgcm(i,lt(i)))
+            ENDDO
+         ENDDO
+
+      ENDIF ! lnew
+
+c======================================================================
+c    inteprollation
+c    ET je mets les vents a zero quand je rencontre une montagne
+c======================================================================
+
+      DO nlev = 1, klevSTD
+         DO i=1,klon
+            IF (pgcm(i,1).LT.pres(nlev)) THEN
+c     Qpres(i)=1e33
+               Qpres(i,nlev) = 1e+20
+            ELSE
+               Qpres(i,nlev) = 
+     &              Qgcm(i,lb(i))*aisb(i,nlev) +
+     &              Qgcm(i,lt(i))*aist(i,nlev)
+            ENDIF
+         ENDDO
+      ENDDO
+
+c     
+      RETURN
+      END