Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/FCTTRE.inc
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/FCTTRE.inc	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/FCTTRE.inc	(revision 633)
@@ -16,5 +16,6 @@
 !
       FOEEW ( PTARG,PDELARG ) = EXP ( &
-     &          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) &
+!    &          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-TEST_RTT) &
+     &          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-273.16) &
      & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
 !
@@ -31,8 +32,10 @@
      &           + 25.21935 * EXP( - 2999.924 / ptarg))
 !
-      dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg &
+!      dqsats(ptarg,pqsarg) = TEST_RLVTT/TEST_RCPD*pqsarg * (3.56654/ptarg &
+      dqsats(ptarg,pqsarg) = 0.2500800E+07/0.1004709E+04*pqsarg * (3.56654/ptarg &
      &                     +2484.896*LOG(10.)/ptarg**2 &
      &                     -0.00320991*LOG(10.))
-      dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)* &
+!     dqsatl(ptarg,pqsarg) = TEST_RLVTT/TEST_RCPD*pqsarg*LOG(10.)* &
+      dqsatl(ptarg,pqsarg) = 0.2500800E+07/0.1004709E+04*pqsarg*LOG(10.)* &
      &                (2948.964/ptarg**2-5.028/LOG(10.)/ptarg &
      &                +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) &
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/albedo.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/albedo.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/albedo.F	(revision 633)
@@ -24,6 +24,6 @@
 ccc      PARAMETER (fmagic=0.7)
 cccIM => a remplacer  
-        PARAMETER (fmagic=1.32)
-c       PARAMETER (fmagic=1.0)
+c       PARAMETER (fmagic=1.32)
+        PARAMETER (fmagic=1.0)
 c       PARAMETER (fmagic=0.7)
       INTEGER npts ! il controle la precision de l'integration
@@ -147,6 +147,6 @@
 ccc      PARAMETER (fmagic=0.7)
 cccIM => a remplacer  
-        PARAMETER (fmagic=1.32)
-c       PARAMETER (fmagic=1.0)
+c       PARAMETER (fmagic=1.32)
+        PARAMETER (fmagic=1.0)
 c       PARAMETER (fmagic=0.7) 
 c
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/calltherm.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/calltherm.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/calltherm.F	(revision 633)
@@ -0,0 +1,124 @@
+!
+! $Header$
+!
+      subroutine calltherm(dtime
+     s      ,pplay,paprs,pphi
+     s      ,u_seri,v_seri,t_seri,q_seri
+     s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
+     s      ,fm_therm,entr_therm)
+
+      implicit none
+#include "dimensions.h"
+#include "dimphy.h"
+#include "thermcell.h"
+
+c  A inclure eventuellement dans les fichiers de configuration
+      data r_aspect_thermals,l_mix_thermals,tho_thermals/4.,10.,0./
+      data w2di_thermals/0/
+
+      REAL dtime
+
+      REAL u_seri(klon,klev),v_seri(klon,klev)
+      REAL t_seri(klon,klev),q_seri(klon,klev)
+      REAL paprs(klon,klev+1)
+      REAL pplay(klon,klev)
+      REAL pphi(klon,klev)
+
+CFH Update Thermiques
+      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
+      REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev)
+      real fm_therm(klon,klev+1),entr_therm(klon,klev)
+
+
+c variables locales
+      REAL d_t_the(klon,klev), d_q_the(klon,klev)
+      REAL d_u_the(klon,klev),d_v_the(klon,klev)
+c
+      real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt
+      save zentr_therm,zfm_therm
+
+      integer i,k
+
+*********************************************************
+
+c  Modele du thermique
+c  ===================
+c         print*,'thermiques: WARNING on passe t au lieu de t_seri'
+       print*,'avant isplit ',nsplit_thermals
+
+
+         fm_therm(:,:)=0.
+         entr_therm(:,:)=0.
+
+c   tests sur les valeurs negatives de l'eau
+         do k=1,klev
+            do i=1,klon
+               if (.not.q_seri(i,k).ge.0.) then
+                   print*,'WARN eau<0 avant therm i=',i,'  k=',k
+     s         ,' dq,q',d_q_the(i,k),q_seri(i,k)
+                  q_seri(i,k)=1.e-15
+               endif
+            enddo
+         enddo
+
+
+         zdt=dtime/float(nsplit_thermals)
+         do isplit=1,nsplit_thermals
+
+cym            CALL thermcell(klon,klev,zdt
+cym     s      ,pplay,paprs,pphi
+cym     s      ,u_seri,v_seri,t_seri,q_seri
+cym     s      ,d_u_the,d_v_the,d_t_the,d_q_the
+cym     s      ,zfm_therm,zentr_therm
+cym     s      ,r_aspect_thermals,l_mix_thermals,w2di_thermals
+cym     s      ,tho_thermals,3)
+
+            CALL thermcell(klon,klev,zdt
+     s      ,pplay,paprs,pphi
+     s      ,u_seri,v_seri,t_seri,q_seri
+     s      ,d_u_the,d_v_the,d_t_the,d_q_the
+     s      ,zfm_therm,zentr_therm
+     s      ,r_aspect_thermals,l_mix_thermals,w2di_thermals
+     s      ,tho_thermals)
+
+c  transformation de la derivee en tendance
+            d_t_the(:,:)=d_t_the(:,:)*dtime/float(nsplit_thermals)
+            d_u_the(:,:)=d_u_the(:,:)*dtime/float(nsplit_thermals)
+            d_v_the(:,:)=d_v_the(:,:)*dtime/float(nsplit_thermals)
+            d_q_the(:,:)=d_q_the(:,:)*dtime/float(nsplit_thermals)
+            fm_therm(:,:)=fm_therm(:,:)
+     s      +zfm_therm(:,:)/float(nsplit_thermals)
+            entr_therm(:,:)=entr_therm(:,:)
+     s       +zentr_therm(:,:)/float(nsplit_thermals)
+            fm_therm(:,klev+1)=0.
+
+
+
+c  accumulation de la tendance
+            d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)
+            d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)
+            d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
+            d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
+
+c  incrementation des variables meteo
+            t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)
+            u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)
+            v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)
+            q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
+
+c   tests sur les valeurs negatives de l'eau
+            DO k = 1, klev
+            DO i = 1, klon
+               if (.not.q_seri(i,k).ge.0.) then
+                   print*,'WARN eau<0 apres therm i=',i,'  k=',k
+     s         ,' dq,q',d_q_the(i,k),q_seri(i,k)
+                  q_seri(i,k)=1.e-15
+               endif
+            ENDDO
+            ENDDO
+
+         enddo ! isplit
+
+      return
+
+      end
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/clmain.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/clmain.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/clmain.F	(revision 633)
@@ -17,6 +17,6 @@
      .                  d_t,d_q,d_u,d_v,d_ts,
      .                  flux_t,flux_q,flux_u,flux_v,cdragh,cdragm,
+     .                  q2,
      .                  dflux_t,dflux_q,
-cIM cf JLD    .                  zcoefh,zu1,zv1, t2m, q2m, u10m, v10m)
      .                  zcoefh,zu1,zv1, t2m, q2m, u10m, v10m,
      .                  fqcalving,ffonte, run_off_lic_0)
@@ -89,4 +89,5 @@
 #include "dimsoil.h"
 #include "iniprint.h"
+#include "compbl.h"
 c
       REAL dtime
@@ -183,10 +184,20 @@
 cAA      REAL yflxsrf(klon,nbtr)
 c
-      LOGICAL contreg
-      PARAMETER (contreg=.TRUE.)
 c
       LOGICAL ok_nonloc
       PARAMETER (ok_nonloc=.FALSE.)
       REAL ycoefm0(klon,klev), ycoefh0(klon,klev)
+
+      real yzlay(klon,klev),yzlev(klon,klev+1),yteta(klon,klev)
+      real ykmm(klon,klev+1),ykmn(klon,klev+1)
+      real ykmq(klon,klev+1)
+      real yq2(klon,klev+1),q2(klon,klev+1,nbsrf)
+      real q2diag(klon,klev+1)
+      real yustar(klon),y_cd_m(klon),y_cd_h(klon)
+
+
+
+
+
 c
 #include "YOMCST.h"
@@ -220,5 +231,5 @@
       LOGICAL first_appel
       SAVE first_appel
-      DATA first_appel/.false./
+      DATA first_appel/.true./
       LOGICAL debugindex
       SAVE debugindex
@@ -230,4 +241,9 @@
 c
       REAL yt2m(klon), yq2m(klon), yu10m(klon)
+c -- LOOP
+       REAL yu10mx(klon)
+       REAL yu10my(klon)
+       REAL ywindsp(klon)
+c -- LOOP
 c
       REAL uzon(klon), vmer(klon)
@@ -254,5 +270,5 @@
       endif
       IF (first_appel) THEN
-          first_appel=.false.
+!          first_appel=.false.
 !
 ! initialisation sorties netcdf
@@ -340,5 +356,9 @@
       ytsoil = 999999.
       yrugoro = 0.
-
+c -- LOOP
+      yu10mx = 0.0
+      yu10my = 0.0
+      ywindsp = 0.0
+c -- LOOP
       DO nsrf = 1, nbsrf
       DO i = 1, klon
@@ -447,4 +467,9 @@
         ypaprs(j,klev+1) = paprs(i,klev+1)
         y_run_off_lic_0(j) = run_off_lic_0(i)
+c -- LOOP
+       yu10mx(j) = u10m(i,nsrf)
+       yu10my(j) = v10m(i,nsrf)
+       ywindsp(j) = SQRT(yu10mx(j)*yu10mx(j) + yu10my(j)*yu10my(j) )
+c -- LOOP
       END DO
 C
@@ -479,5 +504,12 @@
 c
 c
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 c calculer Cdrag et les coefficients d'echange
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c  Calcul anciens du LMD. Effectues de toutes facons.
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
       CALL coefkz(nsrf, knon, ypaprs, ypplay,
 cIM 261103
@@ -487,6 +519,25 @@
      .            yqsurf, 
      .            ycoefm, ycoefh)
+
       CALL coefkz2(nsrf, knon, ypaprs, ypplay,yt,
      .                  ycoefm0, ycoefh0)
+      if (first_appel) then
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'Apres coefkz2 '
+          WRITE(lunout,*)'nsrf,knon,yts,yrugos,yqsurf',
+     .    nsrf,knon,yts,yrugos,yqsurf
+          WRITE(lunout,*)'ypaprs(1,k),ypplay(1,k),yu,yv,yt'
+          do k=1,klev
+            WRITE(lunout,*)ypaprs(1,k),ypplay(1,k),
+     .      yu(1,k),yv(1,k),yt(1,k)
+          enddo
+          do k=1,klev
+            WRITE(lunout,*)ycoefm(1,k),ycoefh(1,k),
+     .      ycoefm0(1,k),ycoefh0(1,k)
+          enddo
+        ENDIF
+        first_appel=.false.
+      endif
+
       DO k = 1, klev
       DO i = 1, knon
@@ -495,4 +546,5 @@
       ENDDO
       ENDDO
+
 c
 cIM cf JLD : on seuille ycoefm et ycoefh
@@ -528,6 +580,78 @@
 cIM: 261103
 
-c
+
+      IF (iflag_pbl.ge.3) then
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+c MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+         yzlay(1:knon,1)=
+     .   RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1)))
+     .   *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
+         do k=2,klev
+            yzlay(1:knon,k)=
+     .      yzlay(1:knon,k-1)+RD*0.5*(yt(1:knon,k-1)+yt(1:knon,k))
+     .      /ypaprs(1:knon,k)*(ypplay(1:knon,k-1)-ypplay(1:knon,k))/RG
+         enddo
+         do k=1,klev
+            yteta(1:knon,k)=
+     .      yt(1:knon,k)*(ypaprs(1:knon,1)/ypplay(1:knon,k))**rkappa
+     .      *(1.+0.61*yq(1:knon,k))
+         enddo
+         yzlev(1:knon,1)=0.
+         yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
+         do k=2,klev
+            yzlev(1:knon,k)=0.5*(yzlay(1:knon,k)+yzlay(1:knon,k-1))
+         enddo
+         DO k = 1, klev+1
+            DO j = 1, knon
+               i = ni(j)
+               yq2(j,k)=q2(i,k,nsrf)
+            enddo
+         enddo
+
+
+c   Bug introduit volontairement pour converger avec les resultats
+c  du papier sur les thermiques.
+         if (1.eq.1) then
+         y_cd_m(1:knon) = ycoefm(1:knon,1)
+         y_cd_h(1:knon) = ycoefh(1:knon,1)
+         else
+         y_cd_h(1:knon) = ycoefm(1:knon,1)
+         y_cd_m(1:knon) = ycoefh(1:knon,1)
+         endif
+         call ustarhb(knon,yu,yv,y_cd_m, yustar)
+
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'USTAR = ',yustar
+        ENDIF
+
+c   iflag_pbl peut etre utilise comme longuer de melange
+
+         if (iflag_pbl.ge.11) then
+            call vdif_kcay(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,yq2,q2diag,ykmm,ykmn,yustar,
+     s      iflag_pbl)
+         else
+            call yamada4(knon,dtime,rg,rd,ypaprs,yt
+     s      ,yzlev,yzlay,yu,yv,yteta
+     s      ,y_cd_m,yq2,ykmm,ykmn,ykmq,yustar,
+     s      iflag_pbl)
+         endif
+
+         ycoefm(1:knon,1)=y_cd_m(1:knon)
+         ycoefh(1:knon,1)=y_cd_h(1:knon)
+         ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
+         ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
+
+
+      ENDIF
+
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 c calculer la diffusion des vitesses "u" et "v"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
       CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
      s            y_d_u,y_flux_u)
@@ -545,5 +669,7 @@
 c$$$      enddo
 
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 c calculer la diffusion de "q" et de "h"
+cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
       CALL clqh(dtime, itap, date0,jour, debut,lafin,
      e          rlon, rlat, cufi, cvfi,
@@ -555,10 +681,12 @@
      e          yt,yq,yts,ypaprs,ypplay,
      e          ydelp,yrads,yalb, yalblw, ysnow, yqsurf, 
-     e          yrain_f, ysnow_f, yfder, ytaux, ytauy, 
+     e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
+c -- LOOP
+     e          ywindsp, 
+c -- LOOP
 c$$$     e          ysollw, ysolsw,
      e          ysollw, ysollwdown, ysolsw,yfluxlat,
      s          pctsrf_new, yagesno,
      s          y_d_t, y_d_q, y_d_ts, yz0_new,
-cIM cf JLD    s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q)
      s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q,
      s          y_fqcalving,y_ffonte,y_run_off_lic_0)
@@ -699,23 +827,4 @@
 c
         qairsol(j) = yqsurf(j)
-c$$$        IF (nsrf.EQ.1) THEN
-c$$$          qairsol(j) = yqsurf(j)
-c$$$        ELSE IF(nsrf.GT.1) THEN
-c$$$         zt = ts(i,nsrf)
-c$$$         IF (thermcep) THEN
-c$$$           zdelta = MAX(0.,SIGN(1.,RTT-zt))
-c$$$           zqs = R2ES * FOEEW(zt,zdelta) / ypplay(j,1)
-c$$$           zqs = MIN(0.5,zqs)
-c$$$           zcor = 1./(1.-RETV*zqs)
-c$$$           zqs = zqs*zcor
-c$$$         ELSE
-c$$$           IF (zt .LT. t_coup) THEN
-c$$$             zqs = qsats(zt) / ypplay(j,1)
-c$$$           ELSE
-c$$$             zqs = qsatl(zt) / ypplay(j,1)
-c$$$           ENDIF
-c$$$         ENDIF   
-c$$$         qairsol(j) = zqs
-c$$$        ENDIF   
       ENDDO
 c
@@ -778,4 +887,13 @@
        ENDDO 
 #endif
+
+      do j=1,knon
+         do k=1,klev+1
+         i=ni(j)
+         q2(i,k,nsrf)=yq2(j,k)
+         enddo
+      enddo
+c
+
 99999 CONTINUE
 c
@@ -799,8 +917,10 @@
      e                delp,radsol,albedo,alblw,snow,qsurf, 
      e                precip_rain, precip_snow, fder, taux, tauy,
+c -- LOOP
+     e                ywindsp,
+c -- LOOP
      $                sollw, sollwdown, swnet,fluxlat, 
      s                pctsrf_new, agesno,
      s                d_t, d_q, d_ts, z0_new, 
-cIM cf JLD    s                flux_t, flux_q,dflux_s,dflux_l)
      s                flux_t, flux_q,dflux_s,dflux_l,
      s                fqcalving,ffonte,run_off_lic_0)
@@ -820,4 +940,5 @@
 #include "indicesol.h"
 #include "dimsoil.h"
+#include "iniprint.h"
 
 c Arguments:
@@ -857,4 +978,10 @@
       character*6 ocean
       integer npas, nexca
+c -- LOOP
+       REAL yu10mx(klon)
+       REAL yu10my(klon)
+       REAL ywindsp(klon)
+c -- LOOP
+
 
 c
@@ -901,6 +1028,5 @@
       REAL zdelz
 c======================================================================
-      logical contreg
-      parameter (contreg=.true.)
+#include "compbl.h"
 c======================================================================
 c Rajout pour l'interface
@@ -944,12 +1070,6 @@
       ENDIF
 C
-      if (.not. contreg) then
-        do k = 2, klev
-          do i = 1, knon
-            gamq(i,k) = 0.0
-            gamt(i,k) = 0.0
-          enddo
-        enddo
-      else
+C
+      if (iflag_pbl.eq.1) then
         do k = 3, klev
           do i = 1, knon
@@ -961,4 +1081,11 @@
           gamq(i,2) = 0.0
           gamt(i,2) = -2.5e-03
+        enddo
+      else
+        do k = 2, klev
+          do i = 1, knon
+            gamq(i,k) = 0.0
+            gamt(i,k) = 0.0
+          enddo
         enddo
       endif
@@ -1083,5 +1210,9 @@
      e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
      e precip_rain, precip_snow, sollw, sollwdown, swnet, swdown,
-     e fder, taux, tauy, rugos, rugoro,
+     e fder, taux, tauy, 
+c -- LOOP
+     e ywindsp,
+c -- LOOP
+     e rugos, rugoro,
      e albedo, snow, qsurf,
      e ts, p1lay, psref, radsol,
@@ -1089,5 +1220,4 @@
      s evap, fluxsens, fluxlat, dflux_l, dflux_s,              
      s tsol_rad, tsurf_new, alb_new, alblw, emis_new, z0_new, 
-cIM cf JLD    s pctsrf_new, agesno)
      s pctsrf_new, agesno,fqcalving,ffonte, run_off_lic_0)
 
@@ -1162,4 +1292,5 @@
 #include "dimensions.h"
 #include "dimphy.h"
+#include "iniprint.h"
       INTEGER knon
       REAL dtime
@@ -1288,4 +1419,5 @@
 #include "YOMCST.h"
 #include "indicesol.h"
+#include "iniprint.h"
 c
 c Arguments:
@@ -1335,6 +1467,6 @@
       LOGICAL opt_ec ! formule du Centre Europeen dans l'atmosphere
       PARAMETER (opt_ec=.FALSE.)
-      LOGICAL contreg ! utiliser le contre-gradient dans Ri
-      PARAMETER (contreg=.TRUE.)
+
+#include "compbl.h"
 c
 c Variables locales:
@@ -1379,10 +1511,12 @@
 c
       IF (appel1er) THEN
-         PRINT*, 'coefkz, opt_ec:', opt_ec
-         PRINT*, 'coefkz, richum:', richum
-         IF (richum) PRINT*, 'coefkz, ratqs:', ratqs
-         PRINT*, 'coefkz, isommet:', isommet
-         PRINT*, 'coefkz, tvirtu:', tvirtu
-         appel1er = .FALSE.
+        if (prt_level > 9) THEN
+          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
+          WRITE(lunout,*)'coefkz, richum:', richum
+          IF (richum) WRITE(lunout,*)'coefkz, ratqs:', ratqs
+          WRITE(lunout,*)'coefkz, isommet:', isommet
+          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
+          appel1er = .FALSE.
+        endif
       ENDIF
 c
@@ -1399,22 +1533,16 @@
       ENDDO
 
-c$$$      IF(nsrf.NE.1) THEN
-c$$$      do i = 1, knon
-c$$$        qsurf(i) = qsatl(ts(i))/paprs(i,1)
-c$$$      enddo
-c$$$      ENDIF
-
 c
 c Prescrire la valeur de contre-gradient
 c
-      IF (.NOT.contreg) THEN
-         DO k = 2, klev
-            gamt(k) = 0.0
-         ENDDO
-      ELSE
+      if (iflag_pbl.eq.1) then
          DO k = 3, klev
             gamt(k) = -1.0E-03
          ENDDO
          gamt(2) = -2.5E-03
+      else
+         DO k = 2, klev
+            gamt(k) = 0.0
+         ENDDO
       ENDIF
 cIM cf JLD/ GKtest
@@ -1469,7 +1597,4 @@
       ENDDO
 
-      IF (check) THEN
-      PRINT*,' isommet=',isommet,' knon=',knon
-      ENDIF
 
       DO k = 2, isommet
@@ -1608,4 +1733,5 @@
 #include "YOMCST.h"
 #include "indicesol.h"
+#include "iniprint.h"
 c
 c Arguments:
@@ -1702,4 +1828,5 @@
 #include "YOMCST.h"
 #include "indicesol.h"
+#include "iniprint.h"
       REAL tau_gl ! temps de relaxation pour la glace de mer
 ccc      PARAMETER (tau_gl=86400.0*30.0)
@@ -1783,4 +1910,5 @@
 #include "dimphy.h"
 #include "YOMCST.h"
+#include "iniprint.h"
 c
 c Arguments:
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/clouds_gno.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/clouds_gno.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/clouds_gno.F	(revision 633)
@@ -58,5 +58,7 @@
        LOGICAL lconv(klon)
 
-
+cym
+      cldf(:,:)=0.0
+      
       pi = ACOS(-1.)
       sqrtpi=sqrt(pi)
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/comgeomphy.F90
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/comgeomphy.F90	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/comgeomphy.F90	(revision 633)
@@ -0,0 +1,20 @@
+module comgeomphy
+   real,save,allocatable :: airephy(:)
+   real,save,allocatable :: cuphy(:)
+   real,save,allocatable :: cvphy(:)
+   real,save,allocatable :: rlatd(:)
+   real,save,allocatable :: rlond(:)
+contains
+  
+  subroutine InitComgeomphy
+  use dimphy
+  implicit none
+    
+    allocate(airephy(klon))
+    allocate(cuphy(klon))
+    allocate(cvphy(klon))
+    allocate(rlatd(klon))
+    allocate(rlond(klon))
+  end subroutine InitComgeomphy
+  
+end module comgeomphy
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/compbl.h
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/compbl.h	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/compbl.h	(revision 633)
@@ -0,0 +1,2 @@
+      integer iflag_pbl
+      common/compbl/iflag_pbl
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/concvl.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/concvl.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/concvl.F	(revision 633)
@@ -7,5 +7,7 @@
      .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,
      .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
-     .             qcondc,wd)
+     .             qcondc,wd,
+     .             pmflxr,pmflxs,
+     .             da,phi,mp)
  
 c
@@ -56,4 +58,5 @@
        INTEGER ntra
        REAL work1(klon,klev),work2(klon,klev)
+       REAL pmflxr(klon,klev+1),pmflxs(klon,klev+1)
 c
        REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
@@ -65,4 +68,5 @@
        REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)
        REAL Ma(klon,klev),cape(klon),tvp(klon,klev)
+       real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
        INTEGER iflag(klon)
        REAL rflag(klon)
@@ -88,4 +92,7 @@
 c
 c
+cym
+      snow(:)=0
+      
       IF (ifrst .EQ. 0) THEN
          ifrst = 1
@@ -98,4 +105,5 @@
          DO i=1,klon
          em_ph(i,k) = paprs(i,k) / 100.0
+         pmflxs(i,k)=0.
       ENDDO
       ENDDO
@@ -142,6 +150,8 @@
      $              em_p,em_ph,iflag,
      $              d_t,d_q,d_u,d_v,d_tra,rain,
-     $              cbmf,work1,work2,
-     $              dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape)
+     $              pmflxr,cbmf,work1,work2,
+     $              kbas,ktop,
+     $              dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape,
+     $              da,phi,mp)
 
 C------------------------------------------------------------------
@@ -160,5 +170,11 @@
         ENDDO
       ENDDO
- 
+       DO itra = 1,ntra
+        DO k = 1, klev
+         DO i = 1, klon
+            d_tra(i,k,itra) =dtime*d_tra(i,k,itra) 
+         ENDDO
+        ENDDO
+       ENDDO
 c les traceurs ne sont pas mis dans cette version de convect4:
       if (iflag_con.eq.4) then
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/conf_phys.F90
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/conf_phys.F90	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/conf_phys.F90	(revision 633)
@@ -9,5 +9,6 @@
  &                     ratqsbas,ratqshaut,if_ebil, &
  &		       ok_ade, ok_aie, &
- &                     bl95_b0, bl95_b1)
+ &                     bl95_b0, bl95_b1,&
+ &                     iflag_thermals,nsplit_thermals)
 
    use IOIPSL
@@ -19,5 +20,6 @@
 #include "YOMCST.inc"
 !IM : on inclut/initialise les taux de CH4, N2O, CFC11 et CFC12
-#include "clesphys.inc"
+include "clesphys.inc"
+include "compbl.h"
 !
 ! Configuration de la "physique" de LMDZ a l'aide de la fonction
@@ -51,4 +53,5 @@
   real                 :: zzz
 
+  integer :: iflag_thermals,nsplit_thermals
 !
 !
@@ -514,4 +517,35 @@
   ok_kzmin = .true.
   call getin('ok_kzmin',ok_kzmin)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! PARAMETER FOR THE PLANETARY BOUNDARY LAYER
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!Config Key  = iflag_pbl
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  iflag_pbl = 1
+  call getin('iflag_pbl',iflag_pbl)
+!
+!Config Key  = iflag_thermals
+!Config Desc =
+!Config Def  = 0
+!Config Help =
+!
+  iflag_thermals = 0
+  call getin('iflag_thermals',iflag_thermals)
+!
+!
+!Config Key  = nsplit_thermals
+!Config Desc =
+!Config Def  = 1
+!Config Help =
+!
+  nsplit_thermals = 1
+  call getin('nsplit_thermals',nsplit_thermals)
+
+
 
 !
@@ -606,4 +640,6 @@
   write(numout,*)' lev_histday = ',lev_histday 
   write(numout,*)' lev_histmth = ',lev_histmth 
+  write(numout,*)' iflag_pbl = ', iflag_pbl
+  write(numout,*)' iflag_thermals = ', iflag_thermals
 
   return
@@ -634,5 +670,5 @@
 !Config Help = 
 !
-  tau_calv = 360.
+  tau_calv = 360.*10.
   call getin('tau_calv',tau_calv)
 
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cv3_routines.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/cv3_routines.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cv3_routines.F	(revision 633)
@@ -194,5 +194,6 @@
       real pnk(len), qsnk(len), rh(len), chi(len)
       real A, B ! convect3
-
+cym
+      plcl=0.0
 c@ !-------------------------------------------------------------------
 c@ ! --- Find level of minimum moist static energy
@@ -1194,6 +1195,12 @@
 c=====================================================================
 c
-      do i=1,ncum*nlp
-       hp(i,1)=h(i,1)
+cym      do i=1,ncum*nlp
+cym       hp(i,1)=h(i,1)
+cym      enddo
+
+      do k=1,nlp
+        do i=1,ncum
+	  hp(i,k)=h(i,k)
+	enddo
       enddo
 
@@ -1488,10 +1495,14 @@
             vent(i,k,j)=v(i,j)
             elij(i,k,j)=0.0
-            ment(i,k,j)=0.0
-            sij(i,k,j)=0.0
+cym            ment(i,k,j)=0.0
+cym            sij(i,k,j)=0.0
  385      continue
  390    continue
  400  continue
 
+cym
+      ment(1:ncum,1:nd,1:nd)=0.0
+      sij(1:ncum,1:nd,1:nd)=0.0
+      
 c      do k=1,ntra
 c       do j=1,nd  ! instead nlp
@@ -1620,7 +1631,10 @@
 c=====================================================================
 
-      call zilch(asum,ncum*nd)
-      call zilch(bsum,ncum*nd)
-      call zilch(csum,ncum*nd)
+cym      call zilch(asum,ncum*nd)
+cym      call zilch(bsum,ncum*nd)
+cym      call zilch(csum,ncum*nd)
+      call zilch(asum,nloc*nd)
+      call zilch(csum,nloc*nd)
+      call zilch(csum,nloc*nd)
 
       do il=1,ncum
@@ -2150,5 +2164,5 @@
      :                    ,ment,qent,uent,vent,nent,elij,traent,sig
      :                    ,tv,tvp
-     :                    ,iflag,precip,ft,fr,fu,fv,ftra
+     :                    ,iflag,precip,VPrecip,ft,fr,fu,fv,ftra
      :                    ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
       implicit none
@@ -2172,5 +2186,7 @@
       real water(nloc,na), evap(nloc,na), b(nloc,na)
       real ment(nloc,na,na), qent(nloc,na,na), uent(nloc,na,na)
-      real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+cym      real vent(nloc,na,na), nent(nloc,na), elij(nloc,na,na)
+      real vent(nloc,na,na), elij(nloc,na,na)
+      integer nent(nloc,na)
       real traent(nloc,na,na,ntra)
       real tv(nloc,nd), tvp(nloc,nd)
@@ -2181,4 +2197,5 @@
 c outputs:
       real precip(nloc)
+      real VPrecip(nloc,nd+1)
       real ft(nloc,nd), fr(nloc,nd), fu(nloc,nd), fv(nloc,nd)
       real ftra(nloc,nd,ntra)
@@ -2212,8 +2229,10 @@
        precip(il)=0.0
        wd(il)=0.0     ! gust
+       VPrecip(il,nd+1)=0.
       enddo
 
       do i=1,nd
        do il=1,ncum
+         VPrecip(il,i)=0.0
          ft(il,i)=0.0
          fr(il,i)=0.0
@@ -2254,4 +2273,19 @@
       enddo 
 
+C   ***  CALCULATE VERTICAL PROFILE OF  PRECIPITATIONs IN kg/m2/s  ===
+C
+c MAF rajout pour lessivage
+       do k=1,nl
+         do il=1,ncum
+          if (k.le.inb(il)) then
+            if (cvflag_grav) then
+             VPrecip(il,k) = wt(il,k)*sigd*water(il,k)/grav
+            else
+             VPrecip(il,k) = wt(il,k)*sigd*water(il,k)/10.
+            endif 
+          endif
+         end do
+       end do
+C
 c
 c   ***  Calculate downdraft velocity scale    ***
@@ -3009,12 +3043,15 @@
       SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
      :         ,iflag
-     :         ,precip,sig,w0
+     :         ,precip,VPrecip,sig,w0
      :         ,ft,fq,fu,fv,ftra
+     :         ,inb
      :         ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
+     :         ,da,phi,mp
      :         ,iflag1
-     :         ,precip1,sig1,w01
+     :         ,precip1,VPrecip1,sig1,w01
      :         ,ft1,fq1,fu1,fv1,ftra1
+     :         ,inb1
      :         ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1
-     :                               )
+     :         ,da1,phi1,mp1)
       implicit none
 
@@ -3025,5 +3062,7 @@
       integer idcum(nloc)
       integer iflag(nloc)
+      integer inb(nloc)
       real precip(nloc)
+      real VPrecip(nloc,nd+1)
       real sig(nloc,nd), w0(nloc,nd)
       real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
@@ -3033,8 +3072,11 @@
       real qcondc(nloc,nd)
       real wd(nloc),cape(nloc)
+      real da(nloc,nd),phi(nloc,nd,nd),mp(nloc,nd)
 
 c outputs:
       integer iflag1(len)
+      integer inb1(len)
       real precip1(len)
+      real VPrecip1(len,nd+1)
       real sig1(len,nd), w01(len,nd)
       real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
@@ -3044,4 +3086,5 @@
       real qcondc1(nloc,nd)
       real wd1(nloc),cape1(nloc)
+      real da1(nloc,nd),phi1(nloc,nd,nd),mp1(nloc,nd)
 
 c local variables:
@@ -3052,4 +3095,5 @@
          iflag1(idcum(i))=iflag(i)
          wd1(idcum(i))=wd(i)
+         inb1(idcum(i))=inb(i)
          cape1(idcum(i))=cape(i)
  2000   continue
@@ -3057,4 +3101,5 @@
         do 2020 k=1,nl
           do 2010 i=1,ncum
+            VPrecip1(idcum(i),k)=VPrecip(i,k)
             sig1(idcum(i),k)=sig(i,k)
             w01(idcum(i),k)=w0(i,k)
@@ -3068,4 +3113,6 @@
             dnwd01(idcum(i),k)=dnwd0(i,k)
             qcondc1(idcum(i),k)=qcondc(i,k)
+            da1(idcum(i),k)=da(i,k)
+            mp1(idcum(i),k)=mp(i,k)
  2010     continue
  2020   continue
@@ -3083,4 +3130,11 @@
 c 2110    continue
 c 2100   continue
+        do j=1,nd
+         do k=1,nd 
+          do i=1,ncum
+            phi1(idcum(i),k,j)=phi(i,k,j)
+          end do
+         end do
+        end do
 
         return
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cv_driver.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/cv_driver.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cv_driver.F	(revision 633)
@@ -5,7 +5,9 @@
      &                   t1,q1,qs1,u1,v1,tra1,
      &                   p1,ph1,iflag1,ft1,fq1,fu1,fv1,ftra1,
-     &                   precip1,
+     &                   precip1,VPrecip1,
      &                   cbmf1,sig1,w01,
-     &                   delt,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1)
+     &                   icb1,inb1,
+     &                   delt,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1,
+     &                   da1,phi1,mp1)
 C
       implicit none
@@ -37,4 +39,5 @@
 C      ftra1         Real           Output       tracor tend
 C      precip1       Real           Output       precipitation
+C      VPrecip1      Real           Output       vertical profile of precipitations
 C      cbmf1         Real           Output       cloud base mass flux
 C      sig1          Real           In/Out       section adiabatic updraft
@@ -84,4 +87,5 @@
       real precip1(len)
       real cbmf1(len)
+      real VPrecip1(len,nd+1)
       real Ma1(len,nd)
       real upwd1(len,nd)
@@ -93,4 +97,6 @@
       real cape1(len)     
 
+      real da1(len,nd),phi1(len,nd,nd),mp1(len,nd)
+      real da(len,nd),phi(len,nd,nd),mp(len,nd)
       real tra1(len,nd,ntra)
       real ftra1(len,nd,ntra)
@@ -185,4 +191,6 @@
 !  precip: Scalar convective precipitation rate (mm/day).
 !
+!  VPrecip: Vertical profile of convective precipitation (kg/m2/s).
+!
 !  wd:   A convective downdraft velocity scale. For use in surface
 !        flux parameterizations. See convect.ps file for details.
@@ -213,4 +221,5 @@
       integer nk1(klon)
       integer icb1(klon)
+      integer inb1(klon)
       integer icbs1(klon)
 
@@ -267,5 +276,5 @@
       real ments(nloc,klev,klev), qents(nloc,klev,klev)
       real sij(nloc,klev,klev), elij(nloc,klev,klev)
-      real mp(nloc,klev), qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
+      real qp(nloc,klev), up(nloc,klev), vp(nloc,klev)
       real wt(nloc,klev), water(nloc,klev), evap(nloc,klev)
       real b(nloc,klev), ft(nloc,klev), fq(nloc,klev)
@@ -275,4 +284,5 @@
       real tps(nloc,klev), qprime(nloc), tprime(nloc)
       real precip(nloc)
+      real VPrecip(nloc,klev+1)
       real tra(nloc,klev,ntra), trap(nloc,klev,ntra)
       real ftra(nloc,klev,ntra), traent(nloc,klev,klev,ntra)
@@ -321,6 +331,8 @@
          tp1(i,k)=0.0
          clw1(i,k)=0.0
+cym
+         clw(i,k)=0.0	 
          gz1(i,k) = 0.
-
+         VPrecip1(i,k) = 0.
          Ma1(i,k)=0.0
          upwd1(i,k)=0.0
@@ -344,4 +356,5 @@
         wd1(i)=0.0
         cape1(i)=0.0
+        VPrecip1(i,nd+1)=0.0
  60   continue
 
@@ -550,5 +563,5 @@
      :                     ,ment,qent,uent,vent,nent,elij,traent,sig
      :                     ,tv,tvp
-     o                     ,iflag,precip,ft,fq,fu,fv,ftra
+     o                     ,iflag,precip,VPrecip,ft,fq,fu,fv,ftra
      o                     ,upwd,dnwd,dnwd0,ma,mike,tls,tps,qcondc,wd)
       endif
@@ -566,18 +579,34 @@
 
 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+! --- passive tracers
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+      if (iflag_con.eq.3) then
+       CALL cv3_tracer(nloc,len,ncum,nd,nd,
+     :                  ment,sij,da,phi)
+      endif
+
+!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 ! --- UNCOMPRESS THE FIELDS
 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-
+c set iflag1 =42 for non convective points 
+      do  i=1,len
+        iflag1(i)=42
+      end do
+c
       if (iflag_con.eq.3) then
        CALL cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
      :          ,iflag
-     :          ,precip,sig,w0
+     :          ,precip,VPrecip,sig,w0
      :          ,ft,fq,fu,fv,ftra
+     :          ,inb 
      :          ,Ma,upwd,dnwd,dnwd0,qcondc,wd,cape
+     :          ,da,phi,mp
      o          ,iflag1
-     o          ,precip1,sig1,w01
+     o          ,precip1,VPrecip1,sig1,w01
      o          ,ft1,fq1,fu1,fv1,ftra1
-     o          ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 )
+     o          ,inb1
+     o          ,Ma1,upwd1,dnwd1,dnwd01,qcondc1,wd1,cape1 
+     o          ,da1,phi1,mp1)
       endif
 
@@ -609,5 +638,5 @@
 c -- si .TRUE., on rend la gravite plus explicite et eventuellement
 c differente de 10.0 dans convect3: 
-      cvflag_grav = .FALSE.
+      cvflag_grav = .TRUE.
 
       return
@@ -652,5 +681,6 @@
 c ori      t0  = RTT
        t0  = 273.15 ! convect3 (RTT=273.16)
-       grav= 10.    ! implicitely or explicitely used in convect3
+c maf       grav= 10.    ! implicitely or explicitely used in convect3
+       grav= g    ! implicitely or explicitely used in convect3
       endif
 
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cvltr.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cvltr.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/cvltr.F	(revision 633)
@@ -0,0 +1,144 @@
+c
+c $Header$
+c
+      SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,pplay,x,upd,dnd,dx)
+      IMPLICIT NONE 
+c=====================================================================
+c Objet : convection des traceurs / KE
+c Auteurs: M-A Filiberti and J-Y Grandpeix
+c=====================================================================
+c
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "YOECUMF.h" 
+c
+      REAL pdtime
+      REAL paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
+      REAL pplay(klon,klev)  ! pression pour le milieu de chaque couche
+      REAL x(klon,klev)        ! q de traceur (bas en haut) 
+      REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
+      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
+      REAL upd(klon,klev)      ! saturated updraft mass flux
+      REAL dnd(klon,klev)      ! saturated downdraft mass flux
+c
+c--variables locales      
+      real zed(klon,klev),zmd(klon,klev,klev)
+      real za(klon,klev,klev)
+      real zmfd(klon,klev),zmfa(klon,klev)
+      real zmfp(klon,klev),zmfu(klon,klev)
+      integer i,k,j 
+c test conservation
+c      real conserv
+c =========================================
+c calcul des tendances liees au downdraft
+c =========================================
+      zed(:,:)=0.
+      zmfd(:,:)=0.
+      zmfa(:,:)=0.
+      zmfu(:,:)=0.
+      zmfp(:,:)=0.
+      zmd(:,:,:)=0.
+      za(:,:,:)=0.
+c entrainement
+      do k=1,klev-1
+        do i=1,klon
+          zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
+        end do
+      end do
+c
+c calcul de la matrice d echange
+c matrice de distribution de la masse entrainee en k
+c
+      do k=1,klev
+        do i=1,klon
+          zmd(i,k,k)=zed(i,k)
+        end do
+      end do
+      do k=2,klev
+        do j=k-1,1,-1
+          do i=1,klon
+          if(mp(i,j+1).ne.0) then
+          zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
+          endif
+          end do
+        end do
+      end do
+      do k=1,klev
+        do j=1,klev-1
+          do i=1,klon
+          za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
+          end do
+        end do
+      end do
+c
+c rajout du terme lie a l ascendance induite
+c
+        do j=2,klev
+         do i=1,klon
+          za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
+         end do
+        end do
+C
+c tendances
+c            
+      do k=1,klev
+        do j=1,klev
+          do i=1,klon
+          zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k)-x(i,j))
+          end do
+        end do
+      end do
+c
+c =========================================
+c calcul des tendances liees aux flux satures
+c =========================================
+      do j=1,klev
+        do i=1,klon
+          zmfa(i,j)=da(i,j)*(x(i,1)-x(i,j))
+        end do
+      end do
+      do k=1,klev
+        do j=1,klev
+          do i=1,klon
+          zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k)-x(i,j))
+          end do
+        end do
+      end do
+      do j=1,klev-1
+        do i=1,klon
+          zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1)-x(i,j))
+        end do
+      end do
+      do j=2,klev
+        do i=1,klon
+          zmfu(i,j)=zmfu(i,j)
+     .             +min(0.,upd(i,j)+dnd(i,j))*(x(i,j)-x(i,j-1))
+        end do
+      end do
+
+c =========================================
+c--calcul final des tendances
+c =========================================
+      do k=1, klev
+        do i=1, klon
+          dx(i,k)=(zmfd(i,k)+zmfu(i,k)
+     .      +zmfa(i,k)+zmfp(i,k))*pdtime
+     .      *RG/(paprs(i,k)-paprs(i,k+1))
+c          print*,'dx',k,dx(i,k)
+        enddo
+      enddo
+c
+c test de conservation du traceur
+c      conserv=0.
+c      do k=1, klev
+c        do i=1, klon
+c         conserv=conserv+dx(i,k)*
+c     .     (paprs(i,k)-paprs(i,k+1))/RG
+C
+c        enddo
+c      enddo
+c      print *,'conserv',conserv
+     
+      return
+      end
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/dimphy.F90
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/dimphy.F90	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/dimphy.F90	(revision 633)
@@ -0,0 +1,313 @@
+module dimphy
+
+  
+  logical, save :: monocpu
+!  logical, save :: parallel
+   
+  INTEGER,SAVE :: iiphy_begin
+  INTEGER,SAVE :: iiphy_end
+  INTEGER,SAVE :: jjphy_begin
+  INTEGER,SAVE :: jjphy_end
+  INTEGER,SAVE :: jjphy_nb
+  INTEGER,SAVE :: ijphy_begin
+  INTEGER,SAVE :: ijphy_end
+  INTEGER,SAVE :: ijphy_nb
+  INTEGER,SAVE :: klon_begin
+  INTEGER,SAVE :: klon_end
+  
+  
+  INTEGER,SAVE,allocatable,dimension(:) :: jjphy_para_nb
+  INTEGER,SAVE,allocatable,dimension(:) :: jjphy_para_begin
+  INTEGER,SAVE,allocatable,dimension(:) :: jjphy_para_end
+  INTEGER,SAVE,dimension(:),allocatable :: Liste_i
+  INTEGER,SAVE,dimension(:),allocatable :: Liste_j
+  INTEGER,SAVE,dimension(:),allocatable :: klon_para_nb
+  INTEGER,SAVE,dimension(:),allocatable :: klon_para_begin
+  INTEGER,SAVE,dimension(:),allocatable :: klon_para_end 
+
+  
+  INTEGER,save :: phy_rank
+  INTEGER,save :: phy_size
+  
+
+  INTEGER,save :: klev, klevp1,klevm1,klon,kfdia,kidia
+  INTEGER,save :: klon2
+  INTEGER,save :: nbtr 
+  INTEGER,save :: kdlon, kflev
+  REAL,save,allocatable,dimension(:) :: zmasq
+  
+
+  
+contains
+  
+   subroutine InitDimphy
+   use parallel
+   implicit none
+#include "dimensions90.h"
+#include "paramet90.h" 
+    integer :: rank
+    integer :: i,j,Pos,Index
+    logical,save :: First=.true.
+
+#ifdef CPP_PARALLEL      
+      monocpu=.false.
+#else
+      monocpu = .true.
+#endif
+      
+      if (monocpu) then
+        
+	phy_rank=0
+	phy_size=1
+	
+#ifdef CPP_PARALLEL      
+      else
+ 
+        phy_rank=mpi_rank
+	phy_size=mpi_size
+#endif
+      
+      endif
+
+      if (First) then
+        allocate(jjphy_para_nb(0:phy_size-1))
+        allocate(jjphy_para_begin(0:phy_size-1))
+        allocate(jjphy_para_end(0:phy_size-1))
+        allocate(klon_para_nb(0:phy_size-1))
+        allocate(klon_para_begin(0:phy_size-1))
+        allocate(klon_para_end(0:phy_size-1))
+      endif
+	
+      klev=llm
+      klevp1=klev+1
+      klevm1=klev-1
+      klon2=iim*(jjm-1)+2
+      
+     
+!        do i=0,phy_size-1
+!          klon_para_nb(i)=(klon2/phy_size)
+!          if (i<MOD(klon2,phy_size)) klon_para_nb(i)=klon_para_nb(i)+1
+!          if (i==0) then 
+!            klon_para_begin(i)=1
+!          else 
+!            klon_para_begin(i)=klon_para_end(i-1)+1
+!          endif
+!          klon_para_end(i)=klon_para_begin(i)+klon_para_nb(i)-1
+!        enddo
+      
+      if (First) then
+        do i=0,phy_size-1
+          klon_para_nb(i)=(klon2/phy_size)
+          if (i<MOD(klon2,phy_size)) klon_para_nb(i)=klon_para_nb(i)+1
+        enddo
+      endif
+        
+      do i=0,phy_size-1
+        if (i==0) then 
+          klon_para_begin(i)=1
+        else 
+          klon_para_begin(i)=klon_para_end(i-1)+1
+        endif
+        klon_para_end(i)=klon_para_begin(i)+klon_para_nb(i)-1
+      enddo
+	
+      klon=klon_para_nb(phy_rank)
+      klon_begin=klon_para_begin(phy_rank)
+      klon_end=klon_para_end(phy_rank)
+	
+      nbtr=nqmx-2+1/(nqmx-1)
+
+      kidia=1
+      kfdia=klon
+      
+      if (klon==6818 .and. monocpu) then
+        kdlon=487
+      else
+        kdlon=klon
+      endif
+      kflev=klev
+    
+      if (.not.first) then
+        deallocate(zmasq,liste_i,liste_j)
+      endif
+      
+      allocate(zmasq(klon))
+
+      
+      allocate(Liste_i(klon))
+      allocate(Liste_j(klon))
+    
+      Index=1
+      if (Pole_Nord) then
+        Liste_i(1)=1
+        Liste_j(1)=1
+        iiphy_begin=1
+        jjphy_begin=1
+	ijphy_begin=1
+        Index=Index+1
+      endif
+    
+      Pos=2
+      do j=2,jjm
+        do i=1,iim
+      
+	  if (Pos==klon_begin) then
+            iiphy_begin=i
+            jjphy_begin=j
+	    ijphy_begin=j*iip1+i
+          endif
+       
+          if (Pos==klon_end) then
+            iiphy_end=i
+            jjphy_end=j
+	    ijphy_end=j*iip1+i
+          endif
+        
+          if (Pos>=klon_begin .AND. Pos<=klon_end) then
+            Liste_i(Index)=i
+            Liste_j(Index)=j
+            Index=Index+1
+          endif
+          Pos=Pos+1
+        enddo
+      enddo
+    
+      if (pole_sud) then
+        Liste_i(Index)=1
+        Liste_j(Index)=jjp1
+        iiphy_end=1
+        jjphy_end=jjp1
+	ijphy_end=jjp1*iip1+1
+      endif
+    
+      ijphy_nb=ijphy_end-ijphy_begin+1
+      jjphy_nb=jjphy_end-jjphy_begin+1
+	
+	    
+      Pos=2
+      rank=0
+      jjphy_para_begin(rank)=1
+    
+      do j=2,jjm
+        do i=1,iim
+          if (Pos==klon_para_begin(rank)) then
+            jjphy_para_begin(rank)=j
+          endif
+          if (Pos==klon_para_end(rank)) then
+            jjphy_para_end(rank)=j
+            rank=rank+1
+          endif
+          Pos=Pos+1
+        enddo
+      enddo
+      jjphy_para_end(rank)=jjp1
+      
+      First=.false.    
+   end subroutine InitDimphy
+   
+
+   subroutine GatherField(Fields,Fieldr,ll)
+     implicit none
+#ifdef CPP_PARALLEL      
+     include 'mpif.h'
+#endif
+     INTEGER :: ll
+     REAL, dimension(klon,ll) :: Fields
+     REAL, dimension(klon2,ll) :: Fieldr     
+     REAL, dimension(klon2*ll) :: Field_tmp     
+     INTEGER, dimension(0:phy_size-1) :: displs
+     INTEGER, dimension(0:phy_size-1) :: sendcounts
+     INTEGER :: l,Pos,rank,ierr
+     INTEGER :: klon_b,klon_e, Nb
+     
+     Pos=1     
+     do rank=0,phy_size-1
+       klon_b=klon_para_begin(rank)
+       klon_e=klon_para_end(rank)
+       Nb=klon_para_nb(rank)
+       displs(rank)=Pos-1
+       sendcounts(rank)=Nb*ll
+       Pos=Pos+Nb*ll
+     enddo
+         
+      if (monocpu) then
+        Fieldr(:,:)=Fields(:,:)
+#ifdef CPP_PARALLEL      
+      else
+        call MPI_Gatherv(Fields,klon*ll,MPI_REAL8,Field_tmp,sendcounts,  &
+	                 displs,MPI_REAL8,0,MPI_COMM_WORLD,ierr)
+#endif
+      endif
+      
+     Pos=1     
+     do rank=0,phy_size-1
+       klon_b=klon_para_begin(rank)
+       klon_e=klon_para_end(rank)
+       Nb=klon_para_nb(rank)
+       do l=1,ll
+         Fieldr(klon_b:klon_e,l)=Field_tmp(Pos:Pos+Nb-1)
+	 Pos=Pos+Nb
+       enddo
+     enddo
+      
+   end subroutine GatherField
+
+   subroutine AllGatherField(Fields,Fieldr,ll)
+     implicit none
+#ifdef CPP_PARALLEL      
+     include 'mpif.h'
+#endif   
+     INTEGER :: ll
+     REAL, dimension(klon,ll) :: Fields
+     REAL, dimension(klon2,ll) :: Fieldr     
+     
+     INTEGER :: ierr
+
+#ifdef CPP_PARALLEL             
+     call GatherField(Fields,Fieldr,ll)
+     call MPI_BCAST(Fieldr,klon2*ll,MPI_REAL8,0,MPI_COMM_WORLD,ierr)
+#endif   
+   end subroutine AllGatherField
+   
+           
+   subroutine ScatterField(Fields,Fieldr,ll)
+     implicit none
+#ifdef CPP_PARALLEL      
+     include 'mpif.h'
+#endif
+     INTEGER :: ll
+     REAL, dimension(klon2,ll) :: Fields
+     REAL, dimension(klon,ll) :: Fieldr     
+     REAL, dimension(klon2*ll) :: Field_tmp     
+     INTEGER, dimension(0:phy_size-1) :: displs
+     INTEGER, dimension(0:phy_size-1) :: sendcounts
+     INTEGER :: l,Pos,rank,ierr
+     INTEGER :: klon_b,klon_e, Nb
+
+     Pos=1    
+     do rank=0,phy_size-1
+       klon_b=klon_para_begin(rank)
+       klon_e=klon_para_end(rank)
+       Nb=klon_para_nb(rank)
+       displs(rank)=Pos-1
+       sendcounts(rank)=Nb*ll
+       do l=1,ll
+         Field_tmp(Pos:Pos+Nb-1)=Fields(klon_b:klon_e,l)
+	 Pos=Pos+Nb
+       enddo
+     enddo
+           
+     if (monocpu) then
+       Fieldr(:,:)=Fields(:,:)
+     else
+#ifdef CPP_PARALLEL      
+       call MPI_Scatterv(Field_tmp,sendcounts,displs,MPI_REAL8,         &
+	                 Fieldr,klon*ll,MPI_REAL8,0,MPI_COMM_WORLD,ierr)
+#endif
+     endif
+      
+        
+   end subroutine ScatterField
+   
+   
+end module dimphy
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/fisrtilp.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/fisrtilp.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/fisrtilp.F	(revision 633)
@@ -123,5 +123,7 @@
 c
       DATA appel1er /.TRUE./
-
+cym
+      zdelq=0.0
+      
       IF (appel1er) THEN
 c
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histday.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/ini_histday.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histday.h	(revision 633)
@@ -270,5 +270,5 @@
      .                "ave(X)", zsto,zout)
 c
-         CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
+         CALL histdef(nid_day, "vitw", "Vertical wind", "Pa/s",
      .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histhf.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/ini_histhf.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histhf.h	(revision 633)
@@ -113,9 +113,15 @@
      .                "ave(X)", zsto1,zout)
 c
-c
+c -- LOOP
          CALL histdef(nid_hf, "SWdownOR",
-     .                "Sfce incident SW radiation OR", "W/m^2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
-     .                "ave(X)", zsto1,zout)
+     .                "Sfce incident SW down radiation OR", "W/m^2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto1,zout)
+c
+         CALL histdef(nid_hf, "SWnetOR",
+     .                "Sfce incident SW net radiation OR", "W/m^2",
+     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "ave(X)", zsto1,zout)
+c -- LOOP
 c
          CALL histdef(nid_hf, "LWdownOR",
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histmth.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/ini_histmth.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histmth.h	(revision 633)
@@ -443,9 +443,10 @@
      .                "ave(X)", zsto,zout)
 c
+      ENDIF !iflag_con .GE. 3
+c
          CALL histdef(nid_mth, "prw", "Precipitable water", "kg/m2",
      .                iim,jjmp1,nhori, 1,1,1, -99, 32,
      .                "ave(X)", zsto,zout)
 c
-      ENDIF !iflag_con .GE. 3
 c34EK
 c
@@ -463,5 +464,5 @@
 c
           CALL histdef(nid_mth, "w"//clev(k),
-     .                 "Vertical wind"//clev(k)//"mb","m/s",
+     .                 "Vertical wind"//clev(k)//"mb","Pa/s",
      .                iim,jjmp1,nhori, 1,1,1, -99, 32,
      .                "ave(X)", zsto,zout)
@@ -512,5 +513,5 @@
      .                "ave(X)", zsto,zout)
 c
-         CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
+         CALL histdef(nid_mth, "vitw", "Vertical wind", "Pa/s",
      .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
@@ -534,8 +535,4 @@
 c
          CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "upwd", "saturated updraft", "kg/m2/s",
      .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
@@ -593,8 +590,14 @@
      .                "ave(X)", zsto,zout)
 c
+      IF (iflag_con.GE.3) THEN 
+c
          CALL histdef(nid_mth,"Ma","undilute adiab updraft","kg/m2/s",
      .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
 c
+         CALL histdef(nid_mth, "upwd", "saturated updraft", "kg/m2/s",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c
          CALL histdef(nid_mth, "dnwd", "saturated downdraft","kg/m2/s",
      .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
@@ -604,4 +607,6 @@
      .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
+      ENDIF !iflag_con.GE.3
+c
 c
          CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
@@ -739,19 +744,10 @@
 c     endif
 c
-c        CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "ave(X)", zsto,zout)
-c
          if (nqmax.GE.3) THEN
-         DO iq=1,nqmax-2
-         IF (iq.LE.99) THEN
-         WRITE(str2,'(i2.2)') iq
-         CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-         ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-         ENDIF
+         DO iq=3,nqmax
+         iiq=niadv(iq)
+         CALL histdef(nid_mth, tnom(iq), ttext(iiq), "-",
+     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
          ENDDO
          ENDIF
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histrac.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/ini_histrac.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ini_histrac.h	(revision 633)
@@ -87,5 +87,5 @@
      .                "ave(X)", zsto,zout)
 
-#ifdef INCA_CH4
+#ifdef INCA
 #ifdef INCAINFO
          DO it=1, phtcnt
@@ -224,8 +224,25 @@
      .              "ave(X)", zsto,zout)
          endif
-#endif
-         ENDDO
+
+c---Ajout Olivia
+         CALL histdef(nid_tra, "d_tr_th_"//tnom(iq),
+     .	              "tendance thermique"// ttext(iiq), "?",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "d_tr_cv_"//tnom(iq),
+     .	              "tendance convection"// ttext(iiq), "?",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "d_tr_cl_"//tnom(iq),
+     .	              "tendance couche limite"// ttext(iiq), "?",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+c---fin Olivia	 
+
+#endif
+         ENDDO
+
 #ifdef INCA
-#ifdef INCA_CH4
+!#ifdef INCA_CH4
          CALL histdef(nid_tra, "O3_column", "O3_column",
      .           "DU", iim,jjm+1,nhori, 1,1,1, -99, 32,
@@ -258,5 +275,79 @@
 !    .                "t_sum(X)", zsto,zout)
 
-#endif
+!#ENDIF
+
+!! Ajout Anne
+#ifdef INCA_AER
+! for sulfur cycle
+         CALL histdef(nid_tra, "SO2_p_dmsoh", "SO2_p_dmsoh", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "SO2_p_dmsno3", "SO2_p_dmsno3", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "SO2_p_h2soh", "SO2_p_h2soh", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "SO2_p_dmsooh", "SO2_p_dmsooh", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "DMSO_p_dmsoh", "DMSO_p_dmsoh", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "ASMSAM_p_dmsooh", "ASMSAM_p_dmsooh", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "ASSO4M_p_so2oh", "ASSO4M_p_so2oh", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "ASSO4M_p_so2h2o2", "ASSO4M_p_h2o2","CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "ASSO4M_p_so2o3", "ASSO4M_p_so2o3", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+         CALL histdef(nid_tra, "Wet3D_SO2", "Wet3D_SO2",
+     .           "kg/m2/s", iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .           "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "Wet3D_DMS", "Wet3D_DMS",
+     .           "kg/m2/s", iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .           "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "Wet3D_HNO3", "Wet3D_HNO3",
+     .           "kg/m2/s", iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .           "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "Wet3D_H2O2", "Wet3D_H2O2",
+     .           "kg/m2/s", iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .           "ave(X)", zsto,zout)
+
+         CALL histdef(nid_tra, "PH_HIST", "pH over physics time step", "1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+#endif
+
+#ifdef INCA_NMHC
+         CALL histdef(nid_tra, "CO2_basprod", "CO2_basprod", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "CO2_nmhcprod", "CO2_nmhcprod", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "CO2_radicalprod", "CO2_radicalprod", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "HNO3_prod", "HNO3_prod", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "HNO3_loss", "HNO3_loss", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "CO_prod", "CO_prod", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_tra, "CO_loss", "CO_loss", "CM-3 S-1",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+#endif
+! Fin ajout Anne
 #else
          CALL histdef(nid_tra, "pyu1", "Vent niv 1", "-",
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/initphysto.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/initphysto.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/initphysto.F	(revision 633)
@@ -188,7 +188,17 @@
 c coefh frac_impa,frac_nucl
 	
-	call histdef(fileid, 'coefh', ' ', ' ',
-     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
-     .             32, 'inst(X)', t_ops, t_wrt)
+	call histdef(fileid, "coefh", " ", " ",
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, "inst(X)", t_ops, t_wrt)
+
+c abderrahmane le 16 09 02
+        call histdef(fileid, "fm_th", " ", " ",
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, "inst(X)", t_ops, t_wrt)
+
+        call histdef(fileid, "en_th", " ", " ",
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, "inst(X)", t_ops, t_wrt)
+c fin aj
 	
 	write(*,*) 'apres coefh ds initphysto'	
@@ -283,5 +293,6 @@
 
       call histend(fileid)
-      if (ok_sync) call histsync(fileid)
+c     if (ok_sync) call histsync(fileid)
+      if (ok_sync) call histsync
 
 	
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/initrrnpb.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/initrrnpb.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/initrrnpb.F	(revision 633)
@@ -74,6 +74,4 @@
       DO i = 1,klon
         masktr(i,it) = 0.
-c       IF ( NINT(pctsrf(i,3)) .EQ. 1 ) masktr(i,it) = 1.
-c       fshtr(i,it) = s * masktr(i,it) * pctsrf(i,3)
         IF ( NINT(pctsrf(i,1)) .EQ. 1 ) masktr(i,it) = 1.
         fshtr(i,it) = s * masktr(i,it)
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/interface_surf.F90
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/interface_surf.F90	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/interface_surf.F90	(revision 633)
@@ -64,5 +64,9 @@
       & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
       & precip_rain, precip_snow, sollw, sollwdown, swnet, swdown, &
-      & fder, taux, tauy, rugos, rugoro, &
+      & fder, taux, tauy, &
+! -- LOOP
+      & windsp, &
+! -- LOOP
+      & rugos, rugoro, &
       & albedo, snow, qsurf, &
       & tsurf, p1lay, ps, radsol, &
@@ -127,4 +131,7 @@
 !   fder         derivee des flux (pour le couplage)
 !   taux, tauy   tension de vents
+! -- LOOP
+!   windsp       module du vent a 10m
+! -- LOOP
 !   rugos        rugosite
 !   zmasq        masque terre/ocean
@@ -175,4 +182,7 @@
   real, dimension(klon), intent(IN) :: zmasq
   real, dimension(klon), intent(IN) :: taux, tauy, rugos, rugoro
+! -- LOOP
+  real, dimension(klon), intent(IN) :: windsp
+! -- LOOP
   character (len = 6)  :: ocean
   integer              :: npas, nexca ! nombre et pas de temps couplage
@@ -300,4 +310,8 @@
         call abort_gcm(modname,abort_message,1)
       endif
+!cym      
+      run_off=0.0
+!cym
+
 !!$PB
       ALLOCATE (tmp_rriv(iim,jjm+1), stat=error)
@@ -316,4 +330,7 @@
         call abort_gcm(modname,abort_message,1)
       endif
+      tmp_rriv = 0.0
+      tmp_rcoa = 0.0
+      tmp_rlic = 0.0
 
 !!$
@@ -440,6 +457,11 @@
       & ocean, npas, nexca, debut, lafin, &
       & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
-      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
-      & tsurf_new, alb_new, pctsrf_new)
+      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
+! -- LOOP
+      & windsp, &
+! -- LOOP
+      & zmasq, &
+      & tsurf_new, alb_new, &
+      & pctsrf_new)
 
 !    else if (ocean == 'slab  ') then
@@ -494,6 +516,11 @@
       & ocean, npas, nexca, debut, lafin, &
       & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
-      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
-      & tsurf_new, alb_new, pctsrf_new)
+      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
+! -- LOOP
+      & windsp, &
+! -- LOOP
+      & zmasq, &
+      & tsurf_new, alb_new, &
+      & pctsrf_new)
 
 !    else if (ocean == 'slab  ') then
@@ -545,6 +572,11 @@
       & ocean, npas, nexca, debut, lafin, &
       & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
-      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
-      & tsurf_new, alb_new, pctsrf_new)
+      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
+! -- LOOP
+      & windsp, &
+! -- LOOP
+      & zmasq, &
+      & tsurf_new, alb_new, &
+      & pctsrf_new)
 
       tsurf_temp = tsurf_new
@@ -640,6 +672,11 @@
       & ocean, npas, nexca, debut, lafin, &
       & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
-      & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
-      & tsurf_new, alb_new, pctsrf_new)
+      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
+! -- LOOP
+      & windsp, &
+! -- LOOP
+      & zmasq, &
+      & tsurf_new, alb_new, &
+      & pctsrf_new)
 
 !    else if (ocean == 'slab  ') then
@@ -1194,6 +1231,11 @@
       & ocean, npas, nexca, debut, lafin, &
       & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
-      & fluxlat, fluxsens, fder, albsol, taux, tauy, zmasq, &
-      & tsurf_new, alb_new, pctsrf_new)
+      & fluxlat, fluxsens, fder, albsol, taux, tauy, &
+! -- LOOP
+      & windsp, &
+! -- LOOP
+      & zmasq, &
+      & tsurf_new, alb_new, &
+      & pctsrf_new)
 
 ! Cette routine sert d'interface entre le modele atmospherique et un 
@@ -1238,4 +1280,7 @@
 !   taux         tension de vent en x
 !   tauy         tension de vent en y
+! -- LOOP
+!    windsp       module du vent a 10m
+! -- LOOP
 !   nexca        frequence de couplage
 !   zmasq        masque terre/ocean
@@ -1248,5 +1293,8 @@
 !   alb_ice      albedo de la glace
 !
-
+#ifdef CPP_PSMILE  
+  USE oasis
+  integer :: il_time_secs !time in seconds
+#endif
 
 ! Parametres d'entree
@@ -1265,4 +1313,7 @@
   real, dimension(klon), intent(IN) :: precip_rain, precip_snow
   real, dimension(klon), intent(IN) :: tsurf, fder, albsol, taux, tauy
+! -- LOOP
+   real, dimension(klon), intent(IN) :: windsp
+! -- LOOP
   INTEGER              :: nexca, npas, kstep
   real, dimension(klon), intent(IN) :: zmasq
@@ -1277,4 +1328,7 @@
 ! Variables locales
   integer                    :: j, error, sum_error, ig, cpl_index,i
+! -- LOOP
+  INTEGER :: nsrf
+! -- LOOP
   character (len = 20) :: modname = 'interfoce_cpl'
   character (len = 80) :: abort_message
@@ -1284,4 +1338,7 @@
   real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol
   real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux
+! -- LOOP
+  real, allocatable, dimension(:,:),save :: cpl_windsp
+! -- LOOP
   real, allocatable, dimension(:,:),save :: cpl_tauy
   REAL, ALLOCATABLE, DIMENSION(:,:),SAVE :: cpl_rriv, cpl_rcoa, cpl_rlic
@@ -1291,4 +1348,7 @@
   real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol
   real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux
+! -- LOOP
+  real, allocatable, dimension(:,:,:),save :: tmp_windsp
+! -- LOOP
 !!$  real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa
   REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE :: tmp_tauy
@@ -1298,4 +1358,7 @@
   REAL, DIMENSION(iim, jjm+1) :: wri_evap_sea, wri_rcoa, wri_rriv
   REAL, DIMENSION(iim, jjm+1) :: wri_rain, wri_snow, wri_taux, wri_tauy
+! -- LOOP
+   REAL, DIMENSION(iim, jjm+1) :: wri_windsp
+! -- LOOP
   REAL, DIMENSION(iim, jjm+1) :: wri_calv
   REAL, DIMENSION(iim, jjm+1) :: wri_tauxx, wri_tauyy, wri_tauzz
@@ -1327,8 +1390,14 @@
   INTEGER :: ndexct(iim*(jjm+1)),ndexcs(iim*(jjm+1))
   REAL :: zx_lon(iim,jjm+1), zx_lat(iim,jjm+1), zjulian
-  integer :: idayref, itau_w
+  INTEGER,save :: idayref
+!med  integer :: itau_w
+  integer,save :: itau_w
+! -- LOOP
+  integer :: nb_interf_cpl
+! -- LOOP
 #include "param_cou.h"
 #include "inc_cpl.h"
 #include "temps.inc"
+#include "iniprint.h"
 !
 ! Initialisation
@@ -1363,4 +1432,7 @@
     allocate(cpl_albe(klon,2), stat = error); sum_error = sum_error + error
     allocate(cpl_taux(klon,2), stat = error); sum_error = sum_error + error
+! -- LOOP
+     allocate(cpl_windsp(klon,2), stat = error); sum_error = sum_error + error
+! -- LOOP
     allocate(cpl_tauy(klon,2), stat = error); sum_error = sum_error + error
     ALLOCATE(cpl_rriv(iim,jjm+1), stat=error); sum_error = sum_error + error
@@ -1380,4 +1452,7 @@
     cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
     cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0.
+! -- LOOP
+     cpl_windsp = 0.
+! -- LOOP
 
     sum_error = 0
@@ -1392,6 +1467,11 @@
 !
     idtime = int(dtime)
-    call inicma(npas , nexca, idtime,(jjm+1)*iim)
-
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+    CALL inicma(iim, (jjm+1))
+#else
+   call inicma(npas , nexca, idtime,(jjm+1)*iim)
+#endif
+#endif
 !
 ! initialisation sorties netcdf
@@ -1454,8 +1534,15 @@
 
 ! calcul des fluxs a passer
-
+! -- LOOP
+  nb_interf_cpl = nb_interf_cpl + 1  
+  if (check) write(lunout,*)'passage dans interface_surf.F90 :  ',nb_interf_cpl 
+! -- LOOP
   cpl_index = 1
   if (nisurf == is_sic) cpl_index = 2
   if (cumul) then
+! -- LOOP
+      if (check) write(lunout,*)'passage dans cumul '
+      if (check) write(lunout,*)'valeur de cpl_index ', cpl_index 
+! -- LOOP  
     if (check) write(*,*) modname, 'cumul des champs'
     do ig = 1, knon
@@ -1481,4 +1568,10 @@
       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
        &                          + tauy(ig)        / FLOAT(nexca)
+! -- LOOP
+      IF (cpl_index .EQ. 1) THEN
+      cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) &
+       &                          + windsp(ig)      / FLOAT(nexca) 
+      ENDIF
+! -- LOOP
     enddo
     IF (cpl_index .EQ. 1) THEN 
@@ -1497,6 +1590,14 @@
     if (nisurf == is_oce .and. .not. cumul) then
       if (check) write(*,*)'rentree fromcpl, itime-1 = ',itime-1
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+      il_time_secs=(itime-1)*dtime
+      CALL fromcpl(il_time_secs, iim, (jjm+1),                           &
+     &        read_sst, read_sic, read_sit, read_alb_sic)
+#else
       call fromcpl(itime-1,(jjm+1)*iim,                                  &
      &        read_sst, read_sic, read_sit, read_alb_sic)
+#endif
+#endif
 !
 ! sorties NETCDF des champs recus
@@ -1584,4 +1685,7 @@
       allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error
       allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+! -- LOOP
+       allocate(tmp_windsp(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+! -- LOOP
 !!$      allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error
 !!$      allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error
@@ -1606,4 +1710,7 @@
     call gath2cpl(cpl_albe(1,cpl_index), tmp_albe(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
     call gath2cpl(cpl_taux(1,cpl_index), tmp_taux(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
+! -- LOOP
+     call gath2cpl(cpl_windsp(1,cpl_index), tmp_windsp(1,1,cpl_index), klon, knon,iim,jjm,             knindex)
+! -- LOOP
     call gath2cpl(cpl_tauy(1,cpl_index), tmp_tauy(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
 
@@ -1614,4 +1721,7 @@
       wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0. 
       wri_taux = 0.; wri_tauy = 0.
+! -- LOOP
+       wri_windsp = 0.
+! -- LOOP      
       call gath2cpl(pctsrf(1,is_oce), tamp_srf(1,1,1), klon, klon, iim, jjm, tamp_ind)
       call gath2cpl(pctsrf(1,is_sic), tamp_srf(1,1,2), klon, klon, iim, jjm, tamp_ind)
@@ -1624,4 +1734,8 @@
       wri_evap_ice = tmp_evap(:,:,2)
       wri_evap_sea = tmp_evap(:,:,1)
+! -- LOOP
+       wri_windsp = tmp_windsp(:,:,1)
+! -- LOOP
+
 !!$PB
       wri_rriv = cpl_rriv(:,:)
@@ -1677,32 +1791,55 @@
 ! envoi au coupleur
 !
-      CALL histwrite(nidct,cl_writ(1),itau_w,wri_sol_ice,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(2),itau_w,wri_sol_sea,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(3),itau_w,wri_nsol_ice,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(4),itau_w,wri_nsol_sea,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(5),itau_w,wri_fder_ice,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(6),itau_w,wri_evap_ice,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(7),itau_w,wri_evap_sea,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(8),itau_w,wri_rain,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(9),itau_w,wri_snow,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(10),itau_w,wri_rcoa,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(11),itau_w,wri_rriv,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(12),itau_w,wri_calv,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(13),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(14),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(15),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(16),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(17),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
-      CALL histwrite(nidct,cl_writ(18),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(8),itau_w,wri_sol_ice,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(9),itau_w,wri_sol_sea,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(10),itau_w,wri_nsol_ice,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(11),itau_w,wri_nsol_sea,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(12),itau_w,wri_fder_ice,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(13),itau_w,wri_evap_ice,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(14),itau_w,wri_evap_sea,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(15),itau_w,wri_rain,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(16),itau_w,wri_snow,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(17),itau_w,wri_rcoa,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(18),itau_w,wri_rriv,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(19),itau_w,wri_calv,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(1),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(2),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(3),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(4),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(5),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
+      CALL histwrite(nidct,cl_writ(6),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
+! -- LOOP
+      CALL histwrite(nidct,cl_writ(7),itau_w,wri_windsp,iim*(jjm+1),ndexct)
+! -- LOOP
       CALL histsync(nidct)
 ! pas utile      IF (lafin) CALL histclo(nidct)
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+      il_time_secs=(itime-1)*dtime
+
+      CALL intocpl(il_time_secs, iim, jjm+1, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
+      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
+      & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy,     &
+      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,                       &
+! -- LOOP
+      & wri_windsp,lafin)
+! -- LOOP
+#else
       call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
       & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
       & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy,     &
-      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin )
+      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,                       &
+! -- LOOP
+      & wri_windsp,lafin)
+! -- LOOP
+#endif
+#endif
 ! 
       cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
       cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
       cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0.
+! -- LOOP
+      cpl_windsp = 0.
+! -- LOOP
 !
 ! deallocation memoire variables temporaires
@@ -1719,4 +1856,7 @@
       deallocate(tmp_taux, stat=error); sum_error = sum_error + error
       deallocate(tmp_tauy, stat=error); sum_error = sum_error + error
+! -- LOOP
+      deallocate(tmp_windsp, stat=error); sum_error = sum_error + error
+! -- LOOP
 !!$PB
 !!$      deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
@@ -2582,5 +2722,5 @@
 
 #include "YOETHF.inc"
-#include "FCTTRE.inc"
+!rv#include "FCTTRE.inc"
 #include "indicesol.inc"
 !IM cf JLD
@@ -2639,4 +2779,5 @@
   logical,save         :: first = .true.,second=.false.
   real                 :: coeff_rel
+#include "FCTTRE.inc"
 
 
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/iophy.F90
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/iophy.F90	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/iophy.F90	(revision 633)
@@ -0,0 +1,140 @@
+module iophy
+  
+  REAL,private,allocatable,dimension(:,:),save :: tmp_tab2d
+  REAL,private,allocatable,dimension(:,:,:),save :: tmp_tab3d
+  INTEGER,private,allocatable,dimension(:),save :: ndex2d
+  INTEGER,private,allocatable,dimension(:),save :: ndex3d
+  REAL,private,allocatable,dimension(:),save :: io_lat
+  REAL,private,allocatable,dimension(:),save :: io_lon
+  
+  INTERFACE histwrite_phy
+    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
+  END INTERFACE 
+
+contains
+
+  subroutine init_iophy(lat,lon)
+  use dimphy
+  implicit none
+  include 'dimensions90.h'   
+    real,dimension(iim),intent(in) :: lon
+    real,dimension(jjm+1),intent(in) :: lat
+  
+    allocate(io_lat(jjm+1))
+    io_lat(:)=lat(:)
+    allocate(io_lon(iim))
+    io_lon(:)=lon(:)
+    allocate(tmp_tab2d(iim,jjphy_nb))
+    allocate(tmp_tab3d(iim,jjphy_nb,klev))
+    allocate(ndex2d(iim*jjphy_nb))
+    allocate(ndex3d(iim*jjphy_nb*klev))
+    ndex2d(:)=0
+    ndex3d(:)=0
+
+  end subroutine init_iophy
+  
+  subroutine histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
+  use dimphy
+  use ioipsl
+  use write_field
+  implicit none
+  include 'dimensions90.h'
+    
+    character*(*), intent(IN) :: name
+    integer, intent(in) :: itau0
+    real,intent(in) :: zjulian
+    real,intent(in) :: dtime
+    integer,intent(out) :: nhori
+    integer,intent(out) :: nid_day
+    
+    if (monocpu) then
+      call histbeg(name,iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
+                   1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day)
+    else
+      call histbeg(name//'_'//trim(int2str(phy_rank)),iim,io_lon, jjphy_nb,io_lat(jjphy_begin:jjphy_end), &
+                   1,iim,1,jjphy_nb,itau0, zjulian, dtime, nhori, nid_day)
+    endif
+  
+  end subroutine histbeg_phy
+  
+  subroutine histwrite2d_phy(nid,name,itau,field)
+  use dimphy
+  use ioipsl
+  implicit none
+  include 'dimensions90.h'
+    
+    integer,intent(in) :: nid
+    character*(*), intent(IN) :: name
+    integer, intent(in) :: itau
+    real,dimension(klon),intent(in) :: field
+    
+    CALL phy2dyn(field,tmp_tab2d,1)
+    CALL histwrite(nid,name,itau,tmp_tab2d,iim*jjphy_nb,ndex2d)
+    
+  end subroutine histwrite2d_phy
+  
+  subroutine histwrite3d_phy(nid,name,itau,field)
+  use dimphy
+  use ioipsl
+  implicit none
+  include 'dimensions90.h'
+    
+    integer,intent(in) :: nid
+    character*(*), intent(IN) :: name
+    integer, intent(in) :: itau
+    real,dimension(klon,klev),intent(in) :: field
+    
+    CALL phy2dyn(field,tmp_tab3d,klev)
+    CALL histwrite(nid,name,itau,tmp_tab3d,iim*jjphy_nb*klev,ndex3d)
+    
+  end subroutine histwrite3d_phy
+  
+  
+  subroutine phy2dyn(field_phy,field_dyn,nlev)
+  use dimphy
+  implicit none
+  include 'dimensions90.h'
+  
+    real,dimension(klon,nlev),intent(in) :: field_phy
+    real,dimension(iim,jjphy_nb,nlev),intent(out) :: field_dyn
+    integer,intent(in) :: nlev
+    
+    integer :: next
+    integer :: j,l
+    
+      do l=1,nlev
+        	
+	if (jjphy_begin==jjphy_end) then
+	  field_dyn(:,1,l)=0.
+	  field_dyn(iiphy_begin:iiphy_end,1,l)=field_phy(1:klon,l)
+	else
+	
+	 if (jjphy_begin==1) then
+	    field_dyn(:,1,l)=field_phy(1,l)
+	    next=2
+	 else
+	   field_dyn(:,1,l)=0.
+	   next=iim-iiphy_begin+1
+	   field_dyn(iiphy_begin:iim,1,l)=field_phy(1:next-1,l)   
+	 endif
+	
+	  do j=2,jjphy_nb-1
+	    field_dyn(:,j,l)=field_phy(next:next+iim-1,l)
+	    next=next+iim
+	  enddo
+	  
+	  if (jjphy_end==jjm+1) then
+             field_dyn(:,jjphy_nb,l)=field_phy(klon,l)
+	  else
+	   field_dyn(:,jjphy_nb,l)=0.
+	   field_dyn(1:iiphy_end,jjphy_nb,l)=field_phy(next:next+iiphy_end-1,l)   
+	  endif
+	  
+	endif
+     
+     enddo
+	 
+    end subroutine phy2dyn	    
+  
+	  
+end module iophy
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/newmicro.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/newmicro.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/newmicro.F	(revision 633)
@@ -193,5 +193,5 @@
      .           1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) )  
      .               / (4./3. * RPI * 1000. * cdnc_pi(i,k)) )**(1./3.)
-            radius = MAX(radius*1.e6, 3.) 
+            radius = MAX(radius*1.e6, 5.) 
             
             tc = t(i,k)-273.15
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/oasis.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/oasis.F	(revision 547)
+++ 	(revision )
@@ -1,602 +1,0 @@
-!
-! $Header$
-!
-C $Id$
-C****
-C
-C**** *INICMA*  - Initialize coupled mode communication for atmosphere
-C                 and exchange some initial information with Oasis
-C
-C     Input:
-C     -----
-C       KASTP  : total number of timesteps in atmospheric model
-C       KEXCH  : frequency of exchange (in time steps)
-C       KSTEP  : length of timestep (in seconds)
-C
-C     -----------------------------------------------------------
-C
-      SUBROUTINE inicma(kastp,kexch,kstep,imjm)
-c
-c     INCLUDE "param.h"
-c
-      INTEGER kastp, kexch, kstep,imjm
-      INTEGER iparal(3)
-      INTEGER ifcpl, idt, info, imxtag, istep, jf
-c
-#include "param_cou.h"
-#include "inc_cpl.h"
-      CHARACTER*3 cljobnam      ! experiment name
-      CHARACTER*6 clmodnam      ! model name
-c     EM: not used by Oasis2.4
-CEM      CHARACTER*6 clbid(2)      ! for CLIM_Init call (not used)
-CEM                                ! must be dimensioned by the number of models
-CEM      INTEGER nbid(2)           ! for CLIM_Init call (not used)
-CEM                                ! must be dimensioned by the number of models
-      CHARACTER*5 cloasis       ! coupler name (Oasis)
-      INTEGER imess(4)
-      INTEGER getpid            ! system functions
-      INTEGER nuout
-CEM      LOGICAL llmodel
-      PARAMETER (nuout = 6)
-c
-#include "clim.h"
-#include "mpiclim.h"
-c
-#include "oasis.h"      ! contains the name of communication technique. Here
-                        ! cchan=CLIM only is possible.
-c			! ctype=MPI2
-c
-C     -----------------------------------------------------------
-C
-C*    1. Initializations
-C        ---------------
-C
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' ROUTINE INICMA'
-      WRITE(nuout,*) ' **************'
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) ' '
-c
-c     Define the model name
-c
-      clmodnam = 'lmdz.x'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
-c
-c     Define the coupler name
-c
-      cloasis = 'Oasis'        !  always 'Oasis' as in the coupler
-c
-c
-c     Define symbolic name for fields exchanged from atmos to coupler,
-c         must be the same as (1) of the field  definition in namcouple:
-c
-      cl_writ(1)='COSHFICE'
-      cl_writ(2)='COSHFOCE'
-      cl_writ(3)='CONSFICE'
-      cl_writ(4)='CONSFOCE'
-      cl_writ(5)='CODFLXDT'
-c      cl_writ(6)='COICTEMP'
-      cl_writ(6)='COTFSICE'
-      cl_writ(7)='COTFSOCE'
-      cl_writ(8)='COTOLPSU'
-      cl_writ(9)='COTOSPSU'
-      cl_writ(10)='CORUNCOA'
-      cl_writ(11)='CORIVFLU'
-      cl_writ(12)='COCALVIN'
-c$$$      cl_writ(13)='COZOTAUX'
-c$$$      cl_writ(14)='COZOTAUV'
-c$$$      cl_writ(15)='COMETAUY'
-c$$$      cl_writ(16)='COMETAUU'
-      cl_writ(13)='COTAUXXU'
-      cl_writ(14)='COTAUYYU'
-      cl_writ(15)='COTAUZZU'
-      cl_writ(16)='COTAUXXV'
-      cl_writ(17)='COTAUYYV'
-      cl_writ(18)='COTAUZZV'
-c
-c     Define files name for fields exchanged from atmos to coupler,
-c         must be the same as (6) of the field  definition in namcouple:
-c
-      cl_f_writ(1)='flxatmos'
-      cl_f_writ(2)='flxatmos'
-      cl_f_writ(3)='flxatmos'
-      cl_f_writ(4)='flxatmos'
-      cl_f_writ(5)='flxatmos'
-      cl_f_writ(6)='flxatmos'
-      cl_f_writ(7)='flxatmos'
-      cl_f_writ(8)='flxatmos'
-      cl_f_writ(9)='flxatmos'
-      cl_f_writ(10)='flxatmos'
-      cl_f_writ(11)='flxatmos'
-      cl_f_writ(12)='flxatmos'
-      cl_f_writ(13)='flxatmos'
-      cl_f_writ(14)='flxatmos'
-      cl_f_writ(15)='flxatmos'
-      cl_f_writ(16)='flxatmos'
-      cl_f_writ(17)='flxatmos'
-      cl_f_writ(18)='flxatmos'
-
-c
-c
-c     Define symbolic name for fields exchanged from coupler to atmosphere,
-c         must be the same as (2) of the field  definition in namcouple:
-c
-      cl_read(1)='SISUTESW'
-      cl_read(2)='SIICECOV'
-      cl_read(3)='SIICEALW'
-      cl_read(4)='SIICTEMW'
-c
-c     Define files names for fields exchanged from coupler to atmosphere,
-c         must be the same as (7) of the field  definition in namcouple:
-c
-      cl_f_read(1)='sstatmos'
-      cl_f_read(2)='sstatmos'
-      cl_f_read(3)='sstatmos'
-      cl_f_read(4)='sstatmos'
-c
-c
-c     Define the number of processors involved in the coupling for
-c     Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
-c     in the namcouple); they will be stored in a COMMON in mpiclim.h
-c     (used for CLIM/MPI2 only)
-      mpi_nproc(0)=1
-      mpi_nproc(1)=1
-      mpi_nproc(2)=1 
-c
-c     Define infos to be sent initially to oasis
-c
-      imess(1) = kastp      ! total number of timesteps in atmospheric model
-      imess(2) = kexch      ! period of exchange (in time steps)
-      imess(3) = kstep      ! length of atmospheric timestep (in seconds)
-      imess(4) = getpid()   ! PID of atmospheric model
-c
-c     Initialization and exchange of initial info in the CLIM technique
-c
-      IF (cchan.eq.'CLIM') THEN
-c
-c     Define the experiment name :
-c
-          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
-c
-c         Start the coupling 
-c         (see lib/clim/src/CLIM_Init for the definition of input parameters)
-c
-cEM          clbid(1)='      '
-cEM          clbid(2)='      '
-cEM          nbid(1)=0
-cEM          nbid(2)=0
-CEM          llmodel=.true.
-c
-c         Define the number of processors used by each model as in
-c         $CHATYPE line of namcouple (used for CLIM/MPI2 only) 
-          mpi_totproc(1)=1
-          mpi_totproc(2)=1
-c
-c         Define names of each model as in $NBMODEL line of namcouple
-c         (used for CLIM/MPI2 only)        
-          cmpi_modnam(1)='lmdz.x'
-          cmpi_modnam(2)='opa.xx'
-c         Start the coupling 
-c
-          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
-     *                 kastp, kexch, kstep,
-     *                 5, 3600, 3600, info )
-c
-          IF (info.ne.CLIM_Ok) THEN
-              WRITE ( nuout, *) ' inicma : pb init clim '
-              WRITE ( nuout, *) ' error code is = ', info
-              CALL halte('STOP in inicma')
-            ELSE
-              WRITE(nuout,*) 'inicma : init clim ok '
-          ENDIF
-c
-c         For each coupling field, association of a port to its symbolic name
-c
-c         -Define the parallel decomposition associated to the port of each
-c          field; here no decomposition for all ports.
-          iparal ( clim_strategy ) = clim_serial 
-          iparal ( clim_length   ) = imjm
-          iparal ( clim_offset   ) = 0
-c
-c         -Loop on total number of coupler-to-atmosphere fields
-c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
-          DO jf=1, jpfldo2a
-            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
-     $          , info )  
-            WRITE(nuout,*) 'inicma : clim define done for ',jf
-     $          ,cl_read(jf) 
-          END DO 
-c
-c         -Loop on total number of atmosphere-to-coupler fields 
-c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
-          DO jf=1, jpflda2o1+jpflda2o2
-            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
-     $          iparal, info )   
-            WRITE(nuout,*) 'inicma : clim define done for ',jf
-     $          ,cl_writ(jf) 
-          END DO 
-c
-          WRITE(nuout,*) 'inicma : clim_define ok '
-c
-c         -Join a pvm group, wait for other programs and broadcast usefull 
-c          informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start)
-          CALL CLIM_Start ( imxtag, info )
-          IF (info.ne.clim_ok) THEN
-              WRITE ( nuout, *) 'inicma : pb start clim '
-              WRITE ( nuout, *) ' error code is = ', info
-              CALL halte('stop in inicma')
-            ELSE
-              WRITE ( nuout, *)  'inicma : start clim ok '
-          ENDIF
-c
-c         -Get initial information from Oasis
-c          (see lib/clim/src/CLIM_Stepi)
-          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
-          IF (info .NE. clim_ok) THEN
-              WRITE ( UNIT = nuout, FMT = *)
-     $            ' warning : problem in getting step info ',
-     $            'from oasis '
-              WRITE (UNIT = nuout, FMT = *)
-     $            ' =======   error code number = ', info
-            ELSE
-              WRITE (UNIT = nuout, FMT = *)
-     $            ' got step information from oasis '
-          ENDIF
-          WRITE ( nuout, *) ' number of tstep in oasis ', istep
-          WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
-          WRITE ( nuout, *) ' length of tstep in oasis ', idt
-      ENDIF 
-
-      RETURN
-      END
-
-c $Id$
-      SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo)
-c ======================================================================
-c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST 
-c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages)
-c technique. 
-c======================================================================
-      IMPLICIT none
-      INTEGER imjm, kt
-      REAL sst(imjm)          ! sea-surface-temperature
-      REAL gla(imjm)          ! sea-ice
-      REAL tice(imjm)          ! temp glace
-      REAL albedo(imjm)          ! albedo glace
-c
-      INTEGER nuout             ! listing output unit
-      PARAMETER (nuout=6)
-c
-      INTEGER nuread, ios, iflag, icpliter
-      INTEGER info, jf
-c
-#include "clim.h"
-c
-#include "oasis.h"
-#include "param_cou.h"
-c
-#include "inc_cpl.h"
-c
-c
-      WRITE (nuout,*) ' '
-      WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
-      WRITE (nuout,*) ' '
-      CALL flush (nuout)
-
-
-      IF (cchan.eq.'CLIM') THEN 
-
-c
-c     -Get interpolated oceanic fields from Oasis
-c
-          DO jf=1,jpfldo2a
-            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
-            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
-            IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info)
-            IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info)
-            IF ( info .NE. CLIM_Ok) THEN
-                WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
-                WRITE(nuout,*)'Couplage kt is = ',kt
-                WRITE(nuout,*)'CLIM error code is = ', info
-                CALL halte('STOP in fromcpl.F')
-            ENDIF
-          END DO 
-
-      ENDIF 
-c
-      RETURN
-      END
-
-c $Id$
-      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
-     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, 
-     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v
-     $    , last) 
-c ======================================================================
-c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the 
-c atmospheric coupling fields to the coupler with the CLIM (PVM exchange 
-c messages) technique. 
-c IF last time step, writes output fields to binary files.
-c ======================================================================
-      IMPLICIT NONE
-      INTEGER kt, imjm
-c
-      REAL fsolice(imjm)
-      REAL fsolwat(imjm)
-      REAL fnsolwat(imjm)
-      REAL fnsolice(imjm) 
-      REAL fnsicedt(imjm) 
-      REAL evice(imjm)
-      REAL evwat(imjm)
-      REAL lpre(imjm)
-      REAL spre(imjm)
-      REAL dirunoff(imjm)
-      REAL rivrunoff(imjm)
-      REAL calving(imjm)
-c$$$      REAL tauxu(imjm)
-c$$$      REAL tauxv(imjm)
-c$$$      REAL tauyu(imjm)
-c$$$      REAL tauyv(imjm)
-      REAL tauxx_u(imjm)
-      REAL tauxx_v(imjm)
-      REAL tauyy_u(imjm)
-      REAL tauyy_v(imjm)
-      REAL tauzz_u(imjm)
-      REAL tauzz_v(imjm)
-      LOGICAL last
-c
-      INTEGER nuout
-      PARAMETER (nuout = 6)
-c
-#include "clim.h"
-#include "param_cou.h"
-#include "inc_cpl.h"
-c
-      CHARACTER*8 file_name(jpmaxfld)
-      INTEGER max_file
-      INTEGER file_unit_max, file_unit(jpmaxfld),
-     $    file_unit_field(jpmaxfld) 
-
-      INTEGER icstep, info, jn, jf, ierror
-      LOGICAL trouve
-c
-#include "oasis.h"
-c
-      icstep=kt 
-c
-      WRITE(nuout,*) ' '
-      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
-      WRITE(nuout,*) 'last  ', last
-      WRITE(nuout,*)
-
-      IF (last) THEN 
-c
-c     -WRITE fields to binary files for coupler restart at last time step
-c
-c         -initialisation and files opening
-c
-          max_file=1
-          file_unit_max=99
-c         -keeps first file name
-          file_name(max_file)=cl_f_writ(max_file)
-c         -keeps first file unit
-          file_unit(max_file)=file_unit_max
-c         -decrements file unit maximum
-          file_unit_max=file_unit_max-1
-c         -keeps file unit for field
-          file_unit_field(1)=file_unit(max_file)
-c
-c         -different files names counter
-c
-          DO jf= 2, jpflda2o1 + jpflda2o2
-            trouve=.false.
-            DO jn= 1, max_file
-              IF (.not.trouve) THEN
-                  IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
-c                 -keep file unit for field
-                      file_unit_field(jf)=file_unit(jn)
-                      trouve=.true.
-                  END IF 
-              END IF 
-            END DO 
-            IF (.not.trouve) then
-c           -increment the number of different files
-                max_file=max_file+1
-c           -keep file name
-                file_name(max_file)=cl_f_writ(jf)
-c           -keep file unit for file
-                file_unit(max_file)=file_unit_max
-c           -keep file unit for field
-                file_unit_field(jf)=file_unit(max_file)
-c           -decrement unit maximum number from 99 to 98, ...
-                file_unit_max=file_unit_max-1
-            END IF 
-          END DO 
-c          
-          DO jn=1, max_file 
-            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
-            WRITE(*,*) 'Opening FILE ', file_unit(jn), ' '
-     $          , file_name(jn) 
-            REWIND(file_unit(jn))
-          END DO
-c 
-c         WRITE fields to files          
-          DO jf=1, jpflda2o1 + jpflda2o2
-            IF (jf.eq.1)
-     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.2)
-     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.3)
-     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.4)
-     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.5)
-     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
-     $          file_unit_field(jf), ierror) 
-c            IF (jf.eq.6)
-c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
-c     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.6)
-     $          CALL locwrite(cl_writ(jf),evice, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.7)
-     $          CALL locwrite(cl_writ(jf),evwat, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.8)
-     $          CALL locwrite(cl_writ(jf),lpre, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.9)
-     $          CALL locwrite(cl_writ(jf),spre, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.10)
-     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.11)
-     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
-     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.12)
-     $          CALL locwrite(cl_writ(jf),calving, imjm,
-     $          file_unit_field(jf), ierror) 
-c$$$            IF (jf.eq.13)
-c$$$     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
-c$$$     $          file_unit_field(jf),ierror) 
-c$$$            IF (jf.eq.1')
-c$$$     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
-c$$$     $          file_unit_field(jf),ierror) 
-c$$$            IF (jf.eq.15)
-c$$$     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
-c$$$     $          file_unit_field(jf),ierror) 
-c$$$            IF (jf.eq.16)
-c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
-c$$$     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.13)
-     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
-     $          file_unit_field(jf),ierror)
-            IF (jf.eq.14)
-     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
-     $          file_unit_field(jf),ierror)
-            IF (jf.eq.15)
-     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
-     $          file_unit_field(jf),ierror)
-            IF (jf.eq.16)
-     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
-     $          file_unit_field(jf),ierror)
-            IF (jf.eq.17)
-     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
-     $          file_unit_field(jf),ierror)
-            IF (jf.eq.18)
-     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
-     $          file_unit_field(jf),ierror)
-          END DO 
-C
-C         -simulate a FLUSH
-C
-          DO jn=1, max_file 
-            CLOSE (file_unit(jn))
-          END DO 
-C
-C
-          IF(cchan.eq.'CLIM') THEN 
-C
-C         -inform PVM daemon that message exchange is finished
-C
-              CALL CLIM_Quit (CLIM_ContPvm, info)
-              IF (info .NE. CLIM_Ok) THEN
-                  WRITE (6, *) 
-     $                'An error occured while leaving CLIM. Error = ',
-     $                info
-              ENDIF
-          END IF 
-          RETURN    
-      END IF 
-C
-      IF(cchan.eq.'CLIM') THEN 
-C
-C     -Give atmospheric fields to Oasis
-C 
-          DO jn=1, jpflda2o1 + jpflda2o2
-C            
-          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
-          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
-          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
-          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
-          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
-c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
-          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
-          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
-          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
-          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
-          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
-          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
-          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
-c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
-c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
-c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
-c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
-          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
-          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
-          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
-          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
-          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
-          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
-          
-            IF (info .NE. CLIM_Ok) THEN
-                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
-                WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
-                WRITE (nuout,*) 'Clim error code is = ',info
-                CALL halte('STOP in intocpl ')
-            ENDIF
-          END DO 
-      ENDIF 
-C
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_define
-      print*,'Attention dans oasis.F, pipe_model_define est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_stepi
-      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_recv
-      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_send
-      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
-      RETURN
-      END
-
-      SUBROUTINE quitcpl
-      print *, 'Attention dans oasis.F, quitcpl est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_write_model
-      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_attach
-      print *, 'Attention dans oasis.F, sipc_attach est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_init_model
-      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_read_model
-      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
-      RETURN
-      END
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/oasis.dummy
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/oasis.dummy	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/oasis.dummy	(revision 633)
@@ -20,7 +20,17 @@
 c     INCLUDE "param.h"
 c
-      INTEGER kastp, kexch, kstep,imjm
+      INTEGER kastp, kexch, kstep,imjm,klon
       INTEGER iparal(3)
       INTEGER ifcpl, idt, info, imxtag, istep, jf
+
+c -- LOOP
+c 
+#include "dimensions.h"
+      INTEGER jjmp1
+      PARAMETER (jjmp1=jjm+1-1/jjm)
+#include "dimphy.h"
+       REAL zwindsp(klon)
+c
+c -- LOOP
 c
 #include "param_cou.h"
@@ -72,27 +82,30 @@
 c         must be the same as (1) of the field  definition in namcouple:
 c
-      cl_writ(1)='COSHFICE'
-      cl_writ(2)='COSHFOCE'
-      cl_writ(3)='CONSFICE'
-      cl_writ(4)='CONSFOCE'
-      cl_writ(5)='CODFLXDT'
+      cl_writ(8)='COSHFICE'
+      cl_writ(9)='COSHFOCE'
+      cl_writ(10)='CONSFICE'
+      cl_writ(11)='CONSFOCE'
+      cl_writ(12)='CODFLXDT'
 c      cl_writ(6)='COICTEMP'
-      cl_writ(6)='COTFSICE'
-      cl_writ(7)='COTFSOCE'
-      cl_writ(8)='COTOLPSU'
-      cl_writ(9)='COTOSPSU'
-      cl_writ(10)='CORUNCOA'
-      cl_writ(11)='CORIVFLU'
-      cl_writ(12)='COCALVIN'
+      cl_writ(13)='COTFSICE'
+      cl_writ(14)='COTFSOCE'
+      cl_writ(15)='COTOLPSU'
+      cl_writ(16)='COTOSPSU'
+      cl_writ(17)='CORUNCOA'
+      cl_writ(18)='CORIVFLU'
+      cl_writ(19)='COCALVIN'
 c$$$      cl_writ(13)='COZOTAUX'
 c$$$      cl_writ(14)='COZOTAUV'
 c$$$      cl_writ(15)='COMETAUY'
 c$$$      cl_writ(16)='COMETAUU'
-      cl_writ(13)='COTAUXXU'
-      cl_writ(14)='COTAUYYU'
-      cl_writ(15)='COTAUZZU'
-      cl_writ(16)='COTAUXXV'
-      cl_writ(17)='COTAUYYV'
-      cl_writ(18)='COTAUZZV'
+      cl_writ(1)='COTAUXXU'
+      cl_writ(2)='COTAUYYU'
+      cl_writ(3)='COTAUZZU'
+      cl_writ(4)='COTAUXXV'
+      cl_writ(5)='COTAUYYV'
+      cl_writ(6)='COTAUZZV'
+c -- LOOP
+      cl_writ(7)='COWINDSP'
+c -- LOOP
 c
 c     Define files name for fields exchanged from atmos to coupler,
@@ -117,4 +130,7 @@
       cl_f_writ(17)='flxatmos'
       cl_f_writ(18)='flxatmos'
+c -- LOOP
+      cl_f_writ(19)='flxatmos'
+c -- LOOP
 
 c
@@ -310,8 +326,10 @@
 
 c $Id$
+c -- LOOP
       SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
      $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, 
-     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v
-     $    , last) 
+     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,
+     $    windsp, last)
+c -- LOOP 
 c ======================================================================
 c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the 
@@ -321,4 +339,16 @@
 c ======================================================================
       IMPLICIT NONE
+c -- LOOP
+c 
+#include "dimensions.h"
+      INTEGER jjmp1
+      PARAMETER (jjmp1=jjm+1-1/jjm)
+#include "dimphy.h"
+c      REAL zu10m(klon), zv10m(klon)
+       REAL zwindsp(klon)
+c
+c -- LOOP
+c
+
       INTEGER kt, imjm
 c
@@ -345,4 +375,7 @@
       REAL tauzz_u(imjm)
       REAL tauzz_v(imjm)
+c -- LOOP
+       REAL windsp(imjm)
+c -- LOOP
       LOGICAL last
 c
@@ -424,41 +457,41 @@
 c         WRITE fields to files          
           DO jf=1, jpflda2o1 + jpflda2o2
-            IF (jf.eq.1)
+            IF (jf.eq.8)
      $          CALL locwrite(cl_writ(jf),fsolice, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.2)
+            IF (jf.eq.9)
      $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.3)
+            IF (jf.eq.10)
      $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.4)
+            IF (jf.eq.11)
      $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.5)
+            IF (jf.eq.12)
      $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
      $          file_unit_field(jf), ierror) 
-c            IF (jf.eq.6)
+c            IF (jf.eq.13)
 c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
 c     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.6)
+            IF (jf.eq.13)
      $          CALL locwrite(cl_writ(jf),evice, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.7)
+            IF (jf.eq.14)
      $          CALL locwrite(cl_writ(jf),evwat, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.8)
+            IF (jf.eq.15)
      $          CALL locwrite(cl_writ(jf),lpre, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.9)
+            IF (jf.eq.16)
      $          CALL locwrite(cl_writ(jf),spre, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.10)
+            IF (jf.eq.17)
      $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.11)
+            IF (jf.eq.18)
      $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.12)
+            IF (jf.eq.19)
      $          CALL locwrite(cl_writ(jf),calving, imjm,
      $          file_unit_field(jf), ierror) 
@@ -475,22 +508,28 @@
 c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
 c$$$     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.13)
+            IF (jf.eq.1)
      $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.14)
+            IF (jf.eq.2)
      $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.15)
+            IF (jf.eq.3)
      $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.16)
+            IF (jf.eq.4)
      $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.17)
+            IF (jf.eq.5)
      $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.18)
+            IF (jf.eq.6)
      $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
      $          file_unit_field(jf),ierror)
+c -- LOOP
+            IF (jf.eq.7)
+     $         CALL locwrite(cl_writ(jf),windsp, imjm,
+     $         file_unit_field(jf),ierror)
+c -- LOOP
+
           END DO 
 C
@@ -522,28 +561,30 @@
           DO jn=1, jpflda2o1 + jpflda2o2
 C            
-          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
-          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
-          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
-          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
-          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
+          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
+          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
+         IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
+         IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
+         IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
 c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
-          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
-          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
-          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
-          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
-          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
-          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
-          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
+          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
+          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
+          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
+          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
+          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
+          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
+          IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
 c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
 c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
 c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
 c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
-          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
-          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
-          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
-          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
-          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
-          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
-          
+          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
+          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
+          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
+          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
+          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
+          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
+c -- LOOP
+          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info)
+c -- LOOP          
             IF (info .NE. CLIM_Ok) THEN
                 WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/oasis.true
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/oasis.true	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/oasis.true	(revision 633)
@@ -2,5 +2,4 @@
 ! $Header$
 !
-C $Id$
 C****
 C
@@ -20,7 +19,18 @@
 c     INCLUDE "param.h"
 c
-      INTEGER kastp, kexch, kstep,imjm
+      INTEGER kastp, kexch, kstep,imjm,klon
       INTEGER iparal(3)
       INTEGER ifcpl, idt, info, imxtag, istep, jf
+
+c -- LOOP
+c 
+#include "dimensions.h"
+      INTEGER jjmp1
+      PARAMETER (jjmp1=jjm+1-1/jjm)
+#include "dimphy.h"
+c      REAL zu10m(klon), zv10m(klon)
+       REAL zwindsp(klon)
+c
+c -- LOOP
 c
 #include "param_cou.h"
@@ -43,5 +53,6 @@
 #include "mpiclim.h"
 c
-#include "oasis.h"      ! contains the name of communication technique. Here
+#include "oasis.h"      
+                        ! contains the name of communication technique. Here
                         ! cchan=CLIM only is possible.
 c			! ctype=MPI2
@@ -71,27 +82,30 @@
 c         must be the same as (1) of the field  definition in namcouple:
 c
-      cl_writ(1)='COSHFICE'
-      cl_writ(2)='COSHFOCE'
-      cl_writ(3)='CONSFICE'
-      cl_writ(4)='CONSFOCE'
-      cl_writ(5)='CODFLXDT'
+      cl_writ(8)='COSHFICE'
+      cl_writ(9)='COSHFOCE'
+      cl_writ(10)='CONSFICE'
+      cl_writ(11)='CONSFOCE'
+      cl_writ(12)='CODFLXDT'
 c      cl_writ(6)='COICTEMP'
-      cl_writ(6)='COTFSICE'
-      cl_writ(7)='COTFSOCE'
-      cl_writ(8)='COTOLPSU'
-      cl_writ(9)='COTOSPSU'
-      cl_writ(10)='CORUNCOA'
-      cl_writ(11)='CORIVFLU'
-      cl_writ(12)='COCALVIN'
+      cl_writ(13)='COTFSICE'
+      cl_writ(14)='COTFSOCE'
+      cl_writ(15)='COTOLPSU'
+      cl_writ(16)='COTOSPSU'
+      cl_writ(17)='CORUNCOA'
+      cl_writ(18)='CORIVFLU'
+      cl_writ(19)='COCALVIN'
 c$$$      cl_writ(13)='COZOTAUX'
 c$$$      cl_writ(14)='COZOTAUV'
 c$$$      cl_writ(15)='COMETAUY'
 c$$$      cl_writ(16)='COMETAUU'
-      cl_writ(13)='COTAUXXU'
-      cl_writ(14)='COTAUYYU'
-      cl_writ(15)='COTAUZZU'
-      cl_writ(16)='COTAUXXV'
-      cl_writ(17)='COTAUYYV'
-      cl_writ(18)='COTAUZZV'
+      cl_writ(1)='COTAUXXU'
+      cl_writ(2)='COTAUYYU'
+      cl_writ(3)='COTAUZZU'
+      cl_writ(4)='COTAUXXV'
+      cl_writ(5)='COTAUYYV'
+      cl_writ(6)='COTAUZZV'
+c -- LOOP
+      cl_writ(7)='COWINDSP'
+c -- LOOP
 c
 c     Define files name for fields exchanged from atmos to coupler,
@@ -116,4 +130,7 @@
       cl_f_writ(17)='flxatmos'
       cl_f_writ(18)='flxatmos'
+c -- LOOP
+      cl_f_writ(19)='flxatmos'
+c -- LOOP
 
 c
@@ -311,6 +328,8 @@
       SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
      $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, 
-     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v
-     $    , last) 
+     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,
+c -- LOOP
+     $    windsp, last)
+c -- LOOP 
 c ======================================================================
 c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the 
@@ -320,4 +339,16 @@
 c ======================================================================
       IMPLICIT NONE
+c -- LOOP
+c 
+#include "dimensions.h"
+      INTEGER jjmp1
+      PARAMETER (jjmp1=jjm+1-1/jjm)
+#include "dimphy.h"
+c      REAL zu10m(klon), zv10m(klon)
+       REAL zwindsp(klon)
+c
+c -- LOOP
+c
+
       INTEGER kt, imjm
 c
@@ -344,4 +375,7 @@
       REAL tauzz_u(imjm)
       REAL tauzz_v(imjm)
+c -- LOOP
+       REAL windsp(imjm)
+c -- LOOP
       LOGICAL last
 c
@@ -423,41 +457,41 @@
 c         WRITE fields to files          
           DO jf=1, jpflda2o1 + jpflda2o2
-            IF (jf.eq.1)
+            IF (jf.eq.8)
      $          CALL locwrite(cl_writ(jf),fsolice, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.2)
+            IF (jf.eq.9)
      $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.3)
+            IF (jf.eq.10)
      $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.4)
+            IF (jf.eq.11)
      $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.5)
+            IF (jf.eq.12)
      $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
      $          file_unit_field(jf), ierror) 
-c            IF (jf.eq.6)
+c            IF (jf.eq.13)
 c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
 c     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.6)
+            IF (jf.eq.13)
      $          CALL locwrite(cl_writ(jf),evice, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.7)
+            IF (jf.eq.14)
      $          CALL locwrite(cl_writ(jf),evwat, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.8)
+            IF (jf.eq.15)
      $          CALL locwrite(cl_writ(jf),lpre, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.9)
+            IF (jf.eq.16)
      $          CALL locwrite(cl_writ(jf),spre, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.10)
+            IF (jf.eq.17)
      $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.11)
+            IF (jf.eq.18)
      $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
      $          file_unit_field(jf), ierror) 
-            IF (jf.eq.12)
+            IF (jf.eq.19)
      $          CALL locwrite(cl_writ(jf),calving, imjm,
      $          file_unit_field(jf), ierror) 
@@ -474,22 +508,28 @@
 c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
 c$$$     $          file_unit_field(jf), ierror) 
-            IF (jf.eq.13)
+            IF (jf.eq.1)
      $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.14)
+            IF (jf.eq.2)
      $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.15)
+            IF (jf.eq.3)
      $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.16)
+            IF (jf.eq.4)
      $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.17)
+            IF (jf.eq.5)
      $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
      $          file_unit_field(jf),ierror)
-            IF (jf.eq.18)
+            IF (jf.eq.6)
      $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
      $          file_unit_field(jf),ierror)
+c -- LOOP
+            IF (jf.eq.7)
+     $          CALL locwrite(cl_writ(jf),windsp, imjm,
+     $         file_unit_field(jf),ierror)
+c -- LOOP
+
           END DO 
 C
@@ -521,28 +561,30 @@
           DO jn=1, jpflda2o1 + jpflda2o2
 C            
-          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
-          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
-          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
-          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
-          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
+          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
+          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
+         IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
+         IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
+         IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
 c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
-          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
-          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
-          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
-          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
-          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
-          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
-          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
+          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
+          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
+          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
+          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
+          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
+          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
+          IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
 c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
 c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
 c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
 c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
-          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
-          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
-          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
-          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
-          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
-          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
-          
+          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
+          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
+          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
+          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
+          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
+          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
+c -- LOOP
+          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info)
+c -- LOOP          
             IF (info .NE. CLIM_Ok) THEN
                 WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/orografi.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/orografi.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/orografi.F	(revision 633)
@@ -1277,5 +1277,6 @@
            ZDELPT=PAPHM1(JL,NSTRA)-PAPHM1(JL,KKCRITH(JL))
            PTAU(JL,JK)=ZTAU(JL,KKCRITH(JL)) +
-     *                 (ZTAU(JL,NSTRA)-ZTAU(JL,KKCRITH(JL)))*ZDELP/ZDELPT
+     *                 (ZTAU(JL,NSTRA)-ZTAU(JL,KKCRITH(JL)))*ZDELP
+     .                                                     /ZDELPT
 
        ENDIF
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/param_cou.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/param_cou.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/param_cou.h	(revision 633)
@@ -9,7 +9,9 @@
 	PARAMETER(jpmaxfld = 40)        ! Maximum number of fields exchanged
                                         ! between ocean and atmosphere
+! -- LOOP
 	INTEGER jpflda2o1
-	PARAMETER(jpflda2o1 = 12)         ! Number of fields exchanged from
+	PARAMETER(jpflda2o1 = 13)        ! Number of fields exchanged from
                                          ! atmosphere to ocean via flx.F
+! -- LOOP
 	INTEGER jpflda2o2
 	PARAMETER(jpflda2o2 = 6)         ! Number of fields exchanged from
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phyetat0.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/phyetat0.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phyetat0.F	(revision 633)
@@ -665,31 +665,4 @@
            ENDDO
          ENDDO
-c          IF (nsrf.GT.99) THEN
-c            PRINT*, "Trop de sous-mailles"
-c            CALL abort
-c          ENDIF
-c          WRITE(str2,'(i2.2)') nsrf
-c          ierr = NF_INQ_VARID (nid, "ALBLW"//str2, nvarid)
-c           IF (ierr.NE.NF_NOERR) THEN
-c             PRINT*, "phyetat0: Le champ <ALBLW"//str2//"> est absent"
-c             CALL abort
-c          ENDIF
-c#ifdef NC_DOUBLE
-c           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alblw(1,nsrf))
-c#else
-c           ierr = NF_GET_VAR_REAL(nid, nvarid, alblw(1,nsrf))
-c#endif
-c          IF (ierr.NE.NF_NOERR) THEN
-c            PRINT*, "phyetat0: Lecture echouee pour <ALBLW"//str2//">"
-c            CALL abort
-c          ENDIF
-c          xmin = 1.0E+20
-c          xmax = -1.0E+20
-c          DO i = 1, klon
-c             xmin = MIN(alblw(i,nsrf),xmin)
-c             xmax = MAX(alblw(i,nsrf),xmax)
-c          ENDDO
-c          PRINT*,'Albedo du sol ALBLW**:', nsrf, xmin, xmax
-c        ENDDO
       ELSE
          PRINT*, 'phyetat0: Le champ <ALBLW> est present'
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phyredem.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/phyredem.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phyredem.F	(revision 633)
@@ -3,5 +3,4 @@
 !
 c
-cIM   SUBROUTINE phyredem (fichnom,dtime,radpas,co2_ppm,solaire,
       SUBROUTINE phyredem (fichnom,dtime,radpas,
      .           rlat,rlon, pctsrf,tsol,tsoil,deltat,qsurf,qsol,snow,
@@ -30,6 +29,4 @@
       INTEGER radpas
       REAL rlat(klon), rlon(klon)
-cIM   REAL co2_ppm
-cIM   REAL solaire
       REAL tsol(klon,nbsrf)
       REAL tsoil(klon,nsoilmx,nbsrf)
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/physiq.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/physiq.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/physiq.F	(revision 633)
@@ -2,6 +2,4 @@
 ! $Header$
 !
-C
-c $Header$
 c
       SUBROUTINE physiq (nlon,nlev,nqmax,
@@ -10,5 +8,5 @@
      .            u,v,t,qx,
      .            omega,
-#ifdef INCA_CH4
+#ifdef INCA
      .            flxmass_w,
 #endif
@@ -19,4 +17,5 @@
 #ifdef INCA
       USE chemshut
+      USE species_names
 #ifdef INCA_CH4
 !      USE obs_pos
@@ -36,11 +35,11 @@
 c   CLEFS CPP POUR LES IO
 c   =====================
-c #define histhf
+#define histhf
 #define histday
 #define histmth
 #define histins
-c #define histISCCP
-c #define histREGDYN
-c #define histmthNMC
+c#define histISCCP
+#define histREGDYN
+#define histmthNMC
 c======================================================================
 c    modif   ( P. Le Van ,  12/10/98 )
@@ -84,8 +83,10 @@
 #include "clesphys.h"
 #include "control.h"
+#include "logic.h"
 #include "temps.h"
 #include "comgeomphy.h"
 #include "advtrac.h"
 #include "iniprint.h"
+#include "thermcell.h"
 c======================================================================
       LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
@@ -157,4 +158,10 @@
       PARAMETER (ok_region=.FALSE.)
 c======================================================================
+c     pour phsystoke avec thermiques
+      REAL fm_therm(klon,klev+1)
+      REAL entr_therm(klon,klev)
+      real q2(klon,klev+1,nbsrf)
+      save q2
+c======================================================================
 c
       INTEGER ivap          ! indice de traceurs pour vapeur d'eau
@@ -197,5 +204,5 @@
       REAL omega(klon,klev)
 
-#ifdef INCA_CH4
+#ifdef INCA
       REAL flxmass_w(klon,klev)
 #endif
@@ -205,4 +212,5 @@
       REAL d_qx(klon,klev,nqmax)
       REAL d_ps(klon)
+      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
 
       INTEGER klevp1, klevm1
@@ -368,5 +376,4 @@
       SAVE nhistoWt
 
-      INTEGER linv
       INTEGER pct_ocean(klon,nbregdyn)
       REAL rlonPOS(klon) 
@@ -594,7 +601,7 @@
       REAL zxffonte(klon), zxfqcalving(klon)
 
-      LOGICAL offline           ! Controle du stockage ds "physique"
-      PARAMETER (offline=.false.)
-      INTEGER physid
+c$$$      LOGICAL offline           ! Controle du stockage ds "physique"
+c$$$      PARAMETER (offline=.false.)
+c$$$      INTEGER physid
       REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
       save pfrac_impa
@@ -606,4 +613,5 @@
       REAL frac_nucl(klon,klev) ! idem (nucleation)
 #ifdef INCA
+      INTEGER       :: iii
       REAL          :: calday
 #endif
@@ -620,4 +628,7 @@
       REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
       REAL dlw(klon)    ! derivee infra rouge
+cym
+      SAVE dlw
+cym
       REAL bils(klon) ! bilan de chaleur au sol
       REAL wfbils(klon,nbsrf) ! bilan de chaleur au sol, pour chaque
@@ -759,5 +770,5 @@
       REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
       real zqsat(klon,klev)
-      INTEGER i, k, iq, ig, j, nsrf, ll
+      INTEGER i, k, iq, ig, j, iiq, nsrf, ll
       REAL t_coup
       PARAMETER (t_coup=234.0)
@@ -785,5 +796,5 @@
       INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
 c -- convect43:
-      INTEGER ntra              ! nb traceurs pour convect4.3
+      INTEGER ntra              ! nb traceurs 
       REAL pori_con(klon)    ! pressure at the origin level of lifted parcel
       REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
@@ -807,4 +818,5 @@
       REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
       REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
+      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
       REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
       REAL rneb(klon,klev)
@@ -818,4 +830,7 @@
 c
       INTEGER ibas_con(klon), itop_con(klon)
+cym
+      SAVE ibas_con,itop_con
+cym
       REAL rain_con(klon), rain_lsc(klon)
       REAL snow_con(klon), snow_lsc(klon)
@@ -968,4 +983,7 @@
       LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
       REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)
+cym 
+      SAVE ok_ade, ok_aie, bl95_b0, bl95_b1
+cym
 cjq-end
 c
@@ -976,4 +994,38 @@
 #include "FCTTRE.h"
 c======================================================================
+!rv
+      u10m(:,:)=0.
+      v10m(:,:)=0.
+      t2m(:,:)=0.
+      q2m(:,:)=0.
+      ffonte(:,:)=0.
+      fqcalving(:,:)=0.
+      piz_ae(:,:,:)=0.
+      tau_ae(:,:,:)=0.
+      cg_ae(:,:,:)=0.
+      rain_con(:)=0.
+      snow_con(:)=0.
+      bl95_b0=0.
+      bl95_b1=0.
+      topswai(:)=0.
+      topswad(:)=0.
+      solswai(:)=0.
+      solswad(:)=0.
+!rv
+! anne
+      d_u_con(:,:) = 0.0
+      d_v_con(:,:) = 0.0
+      rnebcon0(:,:) = 0.0
+      clwcon0(:,:) = 0.0
+      rnebcon(:,:) = 0.0
+      clwcon(:,:) = 0.0
+      paire_ter(:) = 0.0
+      nhistoW(:,:,:,:) = 0.0
+      histoW(:,:,:,:) = 0.0
+! fin anne
+
+cym
+      wfbils(:,:)=0
+cym      
       modname = 'physiq'
       IF (if_ebil.ge.1) THEN
@@ -998,5 +1050,5 @@
 c======================================================================
 cIM BEG
-        DO k=1, nlev
+        DO k=1, nlevENS
           DO l=1, nlevSTD
 c
@@ -1034,6 +1086,6 @@
      .                  iflag_cldcon,ratqsbas,ratqshaut, if_ebil,
      .                  ok_ade, ok_aie, 
-     .                  bl95_b0, bl95_b1)
-cIM  .                  , RI0)
+     .                  bl95_b0, bl95_b1,
+     .                  iflag_thermals,nsplit_thermals)
 
 c
@@ -1053,4 +1105,6 @@
      .       run_off_lic_0)
 
+c   ATTENTION : il faudra a terme relire q2 dans l'etat initial
+         q2(:,:,:)=1.e-8
 c
          radpas = NINT( 86400./dtime/nbapp_rad)
@@ -1100,8 +1154,4 @@
 
          WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3  "
-         WRITE(lunout,*)
-     .      "On va utiliser le melange convectif des traceurs qui"
-         WRITE(lunout,*)"est calcule dans convect4.3"
-         WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
 
           DO i = 1, klon
@@ -1114,5 +1164,5 @@
           DO i = 1, klon
            ibas_con(i) = 1
-           itop_con(i) = klev+1
+           itop_con(i) = 1
           ENDDO
 cIM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
@@ -1256,13 +1306,8 @@
      $                   presnivs,
      $                   calday,
-     $                   tracnam,
-     $                   natsnam,
-c     $                   mxoutflds,
-c     $                   outinst,
-c     $                   outtimav,
      $                   klon,
      $                   nqmax,
      $                   pdtphys,
-     $                   anne_ref,
+     $                   annee_ref,
      $                   day_ini)
 #ifdef INCAINFO
@@ -1508,4 +1553,5 @@
      s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
      s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
+     s            q2,
      s            dsens, devap,
      s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m,
@@ -1684,10 +1730,8 @@
       ELSE IF (iflag_con.GE.3) THEN
 c nb of tracers for the KE convection:
-          if (nqmax .GE. 4) then
-              ntra = nbtr
-          else
-              ntra = 1 
-          endif
-c
+c MAF la partie traceurs est faite dans phytrac
+c on met ntra=1 pour limiter les appels mais on peut
+c supprimer les calculs / ftra.
+              ntra = 1
 c sb, oct02:
 c Schema de convection modularise et vectorise:
@@ -1698,5 +1742,5 @@
           CALL concvl (iflag_con,
      .        dtime,paprs,pplay,t_seri,q_seri,
-     .        u_seri,v_seri,tr_seri,nbtr,
+     .        u_seri,v_seri,tr_seri,ntra,
      .        ema_work1,ema_work2,
      .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
@@ -1704,13 +1748,17 @@
      .        upwd,dnwd,dnwd0,
      .        Ma,cape,tvp,iflagctrl,
-     .        pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd)
+     .        pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd,
+     .        pmflxr,pmflxs,
+     .        da,phi,mp)
+
 cIM cf. FH
               clwcon0=qcondc
+              pmfu(:,:)=upwd(:,:)+dnwd(:,:)
 
           ELSE ! ok_cvl
-
+c MAF conema3 ne contient pas les traceurs
           CALL conema3 (dtime,
      .        paprs,pplay,t_seri,q_seri,
-     .        u_seri,v_seri,tr_seri,nbtr,
+     .        u_seri,v_seri,tr_seri,ntra,
      .        ema_work1,ema_work2,
      .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
@@ -1836,25 +1884,43 @@
       zx_ajustq=.FALSE.
 c
-      IF (nqmax.GT.2) THEN !--melange convectif de traceurs
-c
-          IF (iflag_con .NE. 2 .AND. debut) THEN 
-              WRITE(lunout,*)'Pour l instant, seul conflx fonctionne ',
-     $            'avec traceurs', iflag_con
-              WRITE(lunout,*)' Mettre iflag_con', 
-     $            ' = 2 dans run.def et repasser'
-c              CALL abort
-              ENDIF 
-c
-      ENDIF !--nqmax.GT.2
-c
-c Appeler l'ajustement sec
-c
-      CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
-         q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
-      ENDDO
-      ENDDO
+c===================================================================
+c Convection seche (thermiques ou ajustement)
+c===================================================================
+c
+      d_t_ajs(:,:)=0.
+      d_u_ajs(:,:)=0.
+      d_v_ajs(:,:)=0.
+      d_q_ajs(:,:)=0.
+      fm_therm(:,:)=0.
+      entr_therm(:,:)=0.
+c
+      IF(prt_level>9)WRITE(lunout,*)
+     .    'AVANT LA CONVECTION SECHE , iflag_thermals='
+     s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+      if(iflag_thermals.lt.0) then
+c  Rien
+c  ====
+         IF(prt_level>9)WRITE(lunout,*)'pas de convection'
+      else if(iflag_thermals.eq.0) then
+
+c  Ajustement sec
+c  ==============
+         IF(prt_level>9)WRITE(lunout,*)'ajsec'
+         CALL ajsec(paprs, pplay, t_seri,q_seri, d_t_ajs, d_q_ajs)
+         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
+         q_seri(:,:) = q_seri(:,:) + d_q_ajs(:,:)
+      else
+c  Thermiques
+c  ==========
+         IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals='
+     s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+         call calltherm(pdtphys
+     s      ,pplay,paprs,pphi
+     s      ,u_seri,v_seri,t_seri,q_seri
+     s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
+     s      ,fm_therm,entr_therm)
+      endif
+c
+c===================================================================
 c
       IF (if_ebil.ge.2) THEN 
@@ -2305,4 +2371,10 @@
          CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl,
      .        tau_ae, piz_ae, cg_ae, aerindex)
+cym
+      ELSE
+        tau_ae(:,:,:)=0.0
+	piz_ae(:,:,:)=0.0
+	cg_ae(:,:,:)=0.0
+cym     
       ENDIF
 
@@ -2312,5 +2384,5 @@
 #ifdef INCA_AER
       call AEROSOL_METEO_CALC(calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs,
-     &   prfl,psfl,pctsrf,airephy,xjour,rlat,rlon)
+     &   prfl,psfl,pctsrf(1,3),airephy,xjour,rlat,rlon)
 #endif
 
@@ -2318,6 +2390,7 @@
            WRITE(lunout,*)'Appel CHEMHOOK_BEGIN ...'
 #endif
+
            CALL chemhook_begin (calday,
-     $                          pctsrf(1,3),
+     $                          pctsrf(1,1),
      $                          rlat,
      $                          rlon,
@@ -2343,5 +2416,18 @@
      $                          iim,
      $                          jjm,
-     $                          tr_seri)
+#ifdef INCA_AER
+     $                          tr_seri,
+     $                          ftsol,
+     $                          paprs,
+     $                          cdragh,
+     $                          cdragm,
+     $                          pctsrf,
+     $				pdtphys,
+     $				itap)
+#else
+     $                          tr_seri)     
+#endif        
+
+
 #ifdef INCAINFO
            WRITE(lunout,*)'OK.'
@@ -2545,51 +2631,71 @@
 c   Calcul  des tendances traceurs
 c====================================================================
-C Pascale : il faut quand meme apeller phytrac car il gere les sorties
-cKE43       des traceurs => il faut donc mettre des flags a .false.
-      IF (iflag_con.GE.3) THEN
-c           on ajoute les tendances calculees par KE43
-cXXX OM on onhibe la convection sur les traceurs
-        DO iq=1, nqmax-2 ! Sandrine a -3 ???
-cXXX OM on inhibe la convection sur les traceur
-cXXX        DO k = 1, nlev
-cXXX        DO i = 1, klon
-cXXX          tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
-cXXX        ENDDO
-cXXX        ENDDO
-        WRITE(iqn,'(i2.2)') iq
-        CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
-        ENDDO
-CMAF modif pour garder info du nombre de traceurs auxquels
-C la physique s'applique
-      ELSE
-CMAF modif pour garder info du nombre de traceurs auxquels
-C la physique s'applique
 C
-      call phytrac (rnpb,
-     I                   itap, julien, gmtime,
-     I                   debut,lafin,
+      call phytrac (iflag_con,
+     I                   rnpb,
+     I                   itap, 
+     I                   julien, 
+     I                   gmtime,
+     I                   debut,
+     I                   lafin,
      I                   nqmax-2,
-     I                   nlon,nlev,dtime,
-     I                   u,v,t,paprs,pplay,
-     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     I                   ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
-     I                   frac_impa, frac_nucl,
-     I                   rlon,presnivs,pphis,pphi,
+     I                   nlon,
+     I                   nlev,
+     I                   dtime,
+     I                   u,
+     I                   v,
+     I                   t,
+     I                   paprs,
+     I                   pplay,
+     I                   pmfu, 
+     I                   pmfd, 
+     I                   pen_u, 
+     I                   pde_u, 
+     I                   pen_d, 
+     I                   pde_d,
+     I                   ycoefh,
+     I                   fm_therm,
+     I                   entr_therm,
+     I                   yu1,
+     I                   yv1,
+     I                   ftsol,
+     I                   pctsrf,
+     I                   rlat,
+     I                   frac_impa, 
+     I                   frac_nucl,
+     I                   rlon,
+     I                   presnivs,
+     I                   pphis,
+     I                   pphi,
      I                   albsol,
-     I                   qx(1,1,1), rhcl,
-     I                   cldfra, rneb, diafra, cldliq, itop_con,
+     I                   qx(1,1,1), 
+     I                   rhcl,
+     I                   cldfra, 
+     I                   rneb, 
+     I                   diafra, 
+     I                   cldliq, 
+     I                   itop_con,
      I                   ibas_con,
-     I                   pmflxr,pmflxs,prfl,psfl,
-#ifdef INCA_CH4
+     I                   pmflxr,
+     I                   pmflxs,
+     I                   prfl,
+     I                   psfl,
+     I                   da,
+     I                   phi,
+     I                   mp,
+     I                   upwd,
+     I                   dnwd,
+#ifdef INCA
      I                   flxmass_w,
 #endif
      O                   tr_seri)
-      ENDIF 
 
       IF (offline) THEN
 
+         print*,'Attention on met a 0 les thermiques pour phystoke'
 	 call phystokenc (
      I                   nlon,nlev,pdtphys,rlon,rlat,
      I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
+     I                   fm_therm,entr_therm,
      I                   ycoefh,yu1,yv1,ftsol,pctsrf,
      I                   frac_impa, frac_nucl,
@@ -2822,8 +2928,18 @@
      $                        nbtr,
      $                        paprs,
+#ifdef INCA_CH4
      $                        q_seri,
-     $                        anne_ini,
+#endif
+     $                        annee_ref,
      $                        day_ini,
+#ifdef INCA_AER
+     $                        xjour,
+     $                        pphi,
+     $                        pphis,
+     $                        zx_rh,
+     $                        qx(1,1,1))
+#else
      $                        xjour)
+#endif
 #ifdef INCAINFO
            WRITE(lunout,*)'OK.'
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phystokenc.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/phystokenc.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phystokenc.F	(revision 633)
@@ -7,6 +7,7 @@
      I                   nlon,nlev,pdtphys,rlon,rlat,
      I                   pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
+     I                   pfm_therm,pentr_therm,
      I                   pcoefh,yu1,yv1,ftsol,pctsrf,
-     I                   pfrac_impa,pfrac_nucl,
+     I                   frac_impa,frac_nucl,
      I                   pphis,paire,dtime,itap)
       USE ioipsl
@@ -40,5 +41,7 @@
       real pdtphys ! pas d'integration pour la physique (seconde)
 c
-      integer physid, itap,ndex(1)
+      integer physid, itap
+      save physid
+      integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
 
 c   convection:
@@ -51,5 +54,5 @@
       REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
       REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
-	REAL pt(klon,klev)
+	real pt(klon,klev),t(klon,klev)
 c
       REAL rlon(klon), rlat(klon), dtime
@@ -62,10 +65,18 @@
       REAL yv1(klon)
       REAL yu1(klon),pphis(klon),paire(klon)
+
+c   Les Thermiques : (Abderr 25 11 02)
+c   ---------------
+      REAL pfm_therm(klon,klev+1)
+	real fm_therm1(klon,klev)
+      REAL pentr_therm(klon,klev)
+      REAL entr_therm(klon,klev)
+      REAL fm_therm(klon,klev)
 c
 c   Lessivage:
 c   ----------
 c
-      REAL pfrac_impa(klon,klev)
-      REAL pfrac_nucl(klon,klev)
+      REAL frac_impa(klon,klev)
+      REAL frac_nucl(klon,klev)
 c
 c Arguments necessaires pour les sources et puits de traceur
@@ -84,8 +95,4 @@
       REAL de_d(klon,klev) ! flux detraine dans le panache descendant
       REAL coefh(klon,klev) ! flux detraine dans le panache descendant
-	REAL t(klon,klev)
-      REAL frac_impa(klon,klev)
-      REAL frac_nucl(klon,klev)
-      REAL rain(klon)
 
       REAL pyu1(klon),pyv1(klon)
@@ -98,8 +105,9 @@
       integer iadvtr,irec
       real zmin,zmax
-
+      logical ok_sync
+ 
       save t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
+	save fm_therm,entr_therm
       save iadvtr,irec
-      save frac_impa,frac_nucl,rain
       save pyu1,pyv1,pftsol,ppsrf
 
@@ -109,4 +117,6 @@
 c======================================================================
 
+      ok_sync = .true.
+	print*,'Dans phystokenc.F'
       print*,'iadvtr= ',iadvtr
       print*,'istphy= ',istphy
@@ -120,19 +130,19 @@
 	write(*,*) 'apres initphysto ds phystokenc' 
 
-       ndex(1) = 0
-         i=itap 
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-c
-         i=itap
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
 	
       ENDIF
 c
+      ndex2d = 0
+      ndex3d = 0
+      i=itap 
+      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
+      CALL histwrite(physid,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+c
+      i=itap
+      CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
+      CALL histwrite(physid,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+
       iadvtr=iadvtr+1
 c
-c
-c   reinitialisation des champs cumules
       if (mod(iadvtr,istphy).eq.1.or.istphy.eq.1) then
 	print*,'reinitialisation des champs cumules 
@@ -140,6 +150,4 @@
          do k=1,klev
             do i=1,klon
-               frac_impa(i,k)=1.
-               frac_nucl(i,k)=1.
                mfu(i,k)=0.
                mfd(i,k)=0.
@@ -149,9 +157,10 @@
                de_d(i,k)=0.
                coefh(i,k)=0.
-		t(i,k)=0.
-            enddo
-         enddo
-         do i=1,klon
-            rain(i)=0.
+                t(i,k)=0.
+		fm_therm(i,k)=0.
+               entr_therm(i,k)=0.
+            enddo
+         enddo
+         do i=1,klon
             pyv1(i)=0.
             pyu1(i)=0.
@@ -169,6 +178,217 @@
       do k=1,klev
          do i=1,klon
-            frac_impa(i,k)=frac_impa(i,k)*pfrac_impa(i,k)
-            frac_nucl(i,k)=frac_nucl(i,k)*pfrac_nucl(i,k)
+            mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
+            mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
+            en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
+            de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
+            en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
+            de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
+            coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
+                t(i,k)=t(i,k)+pt(i,k)*pdtphys
+       fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
+       entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
+         enddo
+      enddo
+         do i=1,klon
+            pyv1(i)=pyv1(i)+yv1(i)*pdtphys
+            pyu1(i)=pyu1(i)+yu1(i)*pdtphys
+         end do
+         do k=1,nbsrf
+             do i=1,klon
+               pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
+               ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
+            enddo
+         enddo
+
+      dtcum=dtcum+pdtphys
+
+      IF(mod(iadvtr,istphy).eq.0) THEN 
+c
+c   normalisation par le temps cumule
+         do k=1,klev
+            do i=1,klon
+               mfu(i,k)=mfu(i,k)/dtcum
+               mfd(i,k)=mfd(i,k)/dtcum
+               en_u(i,k)=en_u(i,k)/dtcum
+               de_u(i,k)=de_u(i,k)/dtcum
+               en_d(i,k)=en_d(i,k)/dtcum
+               de_d(i,k)=de_d(i,k)/dtcum
+               coefh(i,k)=coefh(i,k)/dtcum
+c Unitel a enlever
+	      t(i,k)=t(i,k)/dtcum	
+               fm_therm(i,k)=fm_therm(i,k)/dtcum
+	       entr_therm(i,k)=entr_therm(i,k)/dtcum
+            enddo
+         enddo
+         do i=1,klon
+            pyv1(i)=pyv1(i)/dtcum
+            pyu1(i)=pyu1(i)/dtcum
+         end do
+         do k=1,nbsrf
+             do i=1,klon
+               pftsol(i,k)=pftsol(i,k)/dtcum
+               pftsol1(i) = pftsol(i,1)
+               pftsol2(i) = pftsol(i,2)
+               pftsol3(i) = pftsol(i,3)
+               pftsol4(i) = pftsol(i,4)
+
+               ppsrf(i,k)=ppsrf(i,k)/dtcum
+               ppsrf1(i) = ppsrf(i,1)
+               ppsrf2(i) = ppsrf(i,2)
+               ppsrf3(i) = ppsrf(i,3)
+               ppsrf4(i) = ppsrf(i,4)
+
+            enddo
+         enddo
+c
+c   ecriture des champs
+c
+         irec=irec+1
+
+ccccc
+         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
+         CALL histwrite(physid,"t",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+
+         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
+      CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+	CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
+      CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
+      CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
+      CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
+      CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)       
+      CALL histwrite(physid,"de_d",itap,zx_tmp_3d,    
+     .                                   iim*(jjm+1)*klev,ndex3d)
+        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)         
+      CALL histwrite(physid,"coefh",itap,zx_tmp_3d,    
+     .                                   iim*(jjm+1)*klev,ndex3d)	
+
+c ajou...
+	do k=1,klev
+           do i=1,klon
+	 fm_therm1(i,k)=fm_therm(i,k)	
+	   enddo
+	enddo
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, fm_therm1, zx_tmp_3d)
+      CALL histwrite(physid,"fm_th",itap,zx_tmp_3d,
+     .                                 iim*(jjm+1)*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, entr_therm, zx_tmp_3d)
+      CALL histwrite(physid,"en_th",itap,zx_tmp_3d,
+     .                                iim*(jjm+1)*klev,ndex3d)
+cccc
+       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
+        CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
+     .  iim*(jjm+1)*klev,ndex3d)
+
+        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
+        CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
+     .  iim*(jjm+1)*klev,ndex3d)
+ 
+        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
+      CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),
+     .                                                ndex2d)
+	
+	CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
+      CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1)
+     .                                                ,ndex2d)
+	
+	CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
+      CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
+      CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
+      CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
+      CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+
+        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
+      CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,   
+     .                                   iim*(jjm+1),ndex2d)
+        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
+      CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
+      CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
+      CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
+     .                                   iim*(jjm+1),ndex2d)
+
+      if (ok_sync) call histsync(physid)
+c     if (ok_sync) call histsync
+	
+c
+cAA Test sur la valeur des coefficients de lessivage 
+c
+         zmin=1e33
+         zmax=-1e33
+         do k=1,klev
+            do i=1,klon
+                  zmax=max(zmax,frac_nucl(i,k))
+                  zmin=min(zmin,frac_nucl(i,k))
+            enddo
+         enddo
+         Print*,'------ coefs de lessivage (min et max) --------'
+         Print*,'facteur de nucleation ',zmin,zmax
+         zmin=1e33
+         zmax=-1e33
+         do k=1,klev
+            do i=1,klon
+                  zmax=max(zmax,frac_impa(i,k))
+                  zmin=min(zmin,frac_impa(i,k))
+            enddo
+         enddo
+         Print*,'facteur d impaction ',zmin,zmax
+
+      ENDIF 
+
+c   reinitialisation des champs cumules
+	go to 768
+      if (mod(iadvtr,istphy).eq.1) then
+         do k=1,klev
+            do i=1,klon
+               mfu(i,k)=0.
+               mfd(i,k)=0.
+               en_u(i,k)=0.
+               de_u(i,k)=0.
+               en_d(i,k)=0.
+               de_d(i,k)=0.
+               coefh(i,k)=0.
+	       t(i,k)=0.
+               fm_therm(i,k)=0.
+	       entr_therm(i,k)=0.
+            enddo
+         enddo
+         do i=1,klon
+            pyv1(i)=0.
+            pyu1(i)=0.
+         end do
+         do k=1,nbsrf
+             do i=1,klon
+               pftsol(i,k)=0.
+               ppsrf(i,k)=0.
+            enddo
+         enddo
+
+         dtcum=0.
+      endif
+
+      do k=1,klev
+         do i=1,klon
             mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
             mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
@@ -179,4 +399,6 @@
             coefh(i,k)=coefh(i,k)+pcoefh(i,k)*pdtphys
 		t(i,k)=t(i,k)+pt(i,k)*pdtphys
+       fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
+       entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
          enddo
       enddo
@@ -193,151 +415,5 @@
 
       dtcum=dtcum+pdtphys
-c
-      IF(mod(iadvtr,istphy).eq.0) THEN
-c
-c   normalisation par le temps cumule
-         do k=1,klev
-            do i=1,klon
-c              frac_impa=frac_impa : c'est la fraction cumulee qu'on stoke
-c              frac_nucl=frac_nucl : c'est la fraction cumulee qu'on stoke
-               mfu(i,k)=mfu(i,k)/dtcum
-               mfd(i,k)=mfd(i,k)/dtcum
-               en_u(i,k)=en_u(i,k)/dtcum
-               de_u(i,k)=de_u(i,k)/dtcum
-               en_d(i,k)=en_d(i,k)/dtcum
-               de_d(i,k)=de_d(i,k)/dtcum
-               coefh(i,k)=coefh(i,k)/dtcum
-		t(i,k)=t(i,k)/dtcum
-            enddo
-         enddo
-         do i=1,klon
-            rain(i)=rain(i)/dtcum
-            pyv1(i)=pyv1(i)/dtcum
-            pyu1(i)=pyu1(i)/dtcum
-         end do
-c modif abderr 23 11 00         do k=1,nbsrf
-             do i=1,klon
-	      do k=1,nbsrf
-               pftsol(i,k)=pftsol(i,k)/dtcum
-	       ppsrf(i,k)=ppsrf(i,k)/dtcum
-	      enddo
-               pftsol1(i) = pftsol(i,1)
-               pftsol2(i) = pftsol(i,2)
-               pftsol3(i) = pftsol(i,3)
-               pftsol4(i) = pftsol(i,4)
-
-c               ppsrf(i,k)=ppsrf(i,k)/dtcum
-               ppsrf1(i) = ppsrf(i,1)
-               ppsrf2(i) = ppsrf(i,2)
-               ppsrf3(i) = ppsrf(i,3)
-               ppsrf4(i) = ppsrf(i,4)
-
-            enddo
-c         enddo
-c
-c   ecriture des champs
-c
-         irec=irec+1
-
-ccccc
-      print*,'AVANT ECRITURE'
-         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t, zx_tmp_3d)
-         CALL histwrite(physid,"t",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-      print*,'APRES ECRITURE'
-
-         CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfu, zx_tmp_3d)
-      CALL histwrite(physid,"mfu",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, mfd, zx_tmp_3d)
-      CALL histwrite(physid,"mfd",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_u, zx_tmp_3d)
-      CALL histwrite(physid,"en_u",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_u, zx_tmp_3d)
-      CALL histwrite(physid,"de_u",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, en_d, zx_tmp_3d)
-      CALL histwrite(physid,"en_d",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, de_d, zx_tmp_3d)
-      CALL histwrite(physid,"de_d",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1, coefh, zx_tmp_3d)
-      CALL histwrite(physid,"coefh",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-cccc
-       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_impa,zx_tmp_3d)
-        CALL histwrite(physid,"frac_impa",itap,zx_tmp_3d,
-     .  iim*(jjm+1)*klev,ndex)
-
-        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,frac_nucl,zx_tmp_3d)
-        CALL histwrite(physid,"frac_nucl",itap,zx_tmp_3d,
-     .  iim*(jjm+1)*klev,ndex)
-
-        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyu1,zx_tmp_2d)
-      CALL histwrite(physid,"pyu1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1, klon,iim,jjm+1, pyv1,zx_tmp_2d)
-      CALL histwrite(physid,"pyv1",itap,zx_tmp_2d,iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol1, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol1",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol2, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol2",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-          CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol3, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol3",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1, pftsol4, zx_tmp_2d)
-      CALL histwrite(physid,"ftsol4",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, rain, zx_tmp_2d)
-      CALL histwrite(physid,"rain",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf1, zx_tmp_2d)
-      CALL histwrite(physid,"psrf1",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf2, zx_tmp_2d)
-      CALL histwrite(physid,"psrf2",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf3, zx_tmp_2d)
-      CALL histwrite(physid,"psrf3",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-        CALL gr_fi_ecrit(1,klon,iim,jjm+1, ppsrf4, zx_tmp_2d)
-      CALL histwrite(physid,"psrf4",itap,zx_tmp_2d,
-     .                                   iim*(jjm+1),ndex)
-
-c
-cAA Test sur la valeur des coefficients de lessivage
-c
-         zmin=1e33
-         zmax=-1e33
-         do k=1,klev
-            do i=1,klon
-                  zmax=max(zmax,frac_nucl(i,k))
-                  zmin=min(zmin,frac_nucl(i,k))
-            enddo
-         enddo
-         Print*,'------ coefs de lessivage (min et max) --------'
-         Print*,'facteur de nucleation ',zmin,zmax
-         zmin=1e33
-         zmax=-1e33
-         do k=1,klev
-            do i=1,klon
-                  zmax=max(zmax,frac_impa(i,k))
-                  zmin=min(zmin,frac_impa(i,k))
-            enddo
-         enddo
-         Print*,'facteur d impaction ',zmin,zmax
-
-      ENDIF
-
+768   continue
 
       RETURN
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phytrac.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/phytrac.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/phytrac.F	(revision 633)
@@ -4,7 +4,11 @@
 c
 c
-      SUBROUTINE phytrac (rnpb,nstep,
-     I                    julien,gmtime,
-     I                    debutphy,lafin,
+      SUBROUTINE phytrac (iflag_con,
+     I                    rnpb,
+     I                    nstep,
+     I                    julien,
+     I                    gmtime,
+     I                    debutphy,
+     I                    lafin,
      I                    nqmax,
      I                    nlon,
@@ -23,4 +27,6 @@
      I                    pde_d,
      I                    coefh,
+     I                    fm_therm,
+     I                    entr_therm,
      I                    yu1,
      I                    yv1,
@@ -47,5 +53,10 @@
      I                    prfl,
      I                    psfl,
-#ifdef INCA_CH4
+     I                    da,
+     I                    phi,
+     I                    mp,
+     I                    upwd,
+     I                    dnwd,
+#ifdef INCA
      I                    flxmass_w,
 #endif
@@ -65,7 +76,14 @@
 #ifdef INCA_AER
       USE AEROSOL_MOD, only : ntr,trmx,trnx
-      USE AEROSOL_DIAG, only : cla,las,tausum,angst,aload,scon
-     .                            ,scavcoef_st,scavcoef_cv
-      USE AEROSOL_PROGNOS, ONLY : md
+      USE AEROSOL_DIAG,only : cla,las,tausum,angst,aload,cload,totaerh2o,tau,
+     $  emiss20,sconc,scavcoef_st,scavcoef_cv
+     $  ,cload05ss  ,cload05bc  ,cload05pom  ,cload05dust  ,cload05so4
+     $  ,cload125ss  ,cload125bc  ,cload125pom  ,cload125dust  ,cload125so4
+      USE AEROSOL_PROGNOS, ONLY : md,mdw
+      USE AEROSOL_METEO, only : airm
+#endif
+#ifdef INCA_NMHC
+      USE RESISTANCE_DIAGNOSE, ONLY : surf_alb, sol_irrad, surf_temp, surf_wind,
+     $                                aero_resist, lamin_resist, surf_resist
 #endif
 #endif
@@ -130,11 +148,13 @@
       logical debutphy       ! le flag de l'initialisation de la physique
       logical lafin          ! le flag de la fin de la physique
-
+c Olivia      
+      integer isplit,nsplit
       REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--lessivage convection
       REAL prfl(klon,klev+1),   psfl(klon,klev+1)     !--lessivage large-scale
 
-#ifdef INCA_CH4
+#ifdef INCA
       REAL flxmass_w(klon,klev)
 #endif
+      integer iflag_con
 
 cAA Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h
@@ -146,7 +166,20 @@
       REAL pmfd(nlon,nlev)  ! flux de masse dans le panache descendant
       REAL pen_u(nlon,nlev) ! flux entraine dans le panache montant
+
+c
+c   thermiques:
+c   -----------
+c
+      real fm_therm(klon,klev+1),entr_therm(klon,klev)
+	real fm_therm1(klon,klev)
+c
       REAL pde_u(nlon,nlev) ! flux detraine dans le panache montant
       REAL pen_d(nlon,nlev) ! flux entraine dans le panache descendant
       REAL pde_d(nlon,nlev) ! flux detraine dans le panache descendant
+c KE
+      real da(nlon,nlev),phi(nlon,nlev,nlev),mp(nlon,nlev)
+      REAL upwd(nlon,nlev)      ! saturated updraft mass flux
+      REAL dnwd(nlon,nlev)      ! saturated downdraft mass flux
+
 c
 c   Couche limite:
@@ -264,6 +297,7 @@
 c
       REAL d_tr(klon,klev), d_trs(klon) ! tendances de traceurs 
-      REAL d_tr_cl(klon,klev) ! tendance de traceurs  couche limite
-      REAL d_tr_cv(klon,klev) ! tendance de traceurs  convection 
+      REAL d_tr_cl(klon,klev,nbtr) ! tendance de traceurs  couche limite
+      REAL d_tr_cv(klon,klev,nbtr) ! tendance de traceurs  conv pour chq traceur
+      REAL d_tr_th(klon,klev,nbtr) ! la tendance des thermiques
       REAL d_tr_dec(klon,klev,nbtr) ! la tendance de la decroissance 
 c                                   ! radioactive du rn - > pb 
@@ -280,4 +314,6 @@
       REAL flestottr(klon,klev,nbtr) ! flux de lessivage 
 c                                    ! dans chaque couche 
+      real zmasse(klon,klev)
+      real ztra_th(klon,klev)
 
 C
@@ -288,33 +324,45 @@
 c-------------
       logical first,couchelimite,convection,lessivage,sorties,
-     s        rnpb,inirnpb
-      save first,couchelimite,convection,lessivage,sorties,
-     s     inirnpb
-      data first,couchelimite,convection,lessivage,sorties
-     s     /.true.,.true.,.false.,.true.,.true./
+     s        rnpb,inirnpb,thermiques
+      save first,couchelimite,convection,lessivage,thermiques,
+     s        sorties,inirnpb
+c      data first,couchelimite,convection,lessivage,sorties
+c     s     /.true.,.true.,.false.,.true.,.true./
+c Olivia
+       data first,couchelimite,convection,lessivage,
+     s      thermiques,sorties
+     s     /.true.,.true.,.true.,.true.,.true.,.true./
+
 
 #ifdef INCA
+      INTEGER           :: lastgas
       INTEGER           :: ncsec
+
+      INTEGER           :: prt_flag_ts(nbtr)=(/1,1,1
 #ifdef INCA_CH4
-#ifdef  INCA_AER
-      INTEGER           :: prt_flag_ts(51)=(/1,1,1
-#else
-      INTEGER           :: prt_flag_ts(43)=(/1,1,1
-#endif
-#else
-#ifdef INCA_AER
-      INTEGER           :: prt_flag_ts(11)=(/1,1,1
-#endif
-#endif
-
-#ifdef INCA_CH4
-     .                                              ,1,0,1,1,0,1,0,
-     .                                         0,0,0,0,0,0,0,1,0,0,
+     .                                              ,0,0,1,1,1,1,1,
+     .                                         0,1,0,0,0,0,0,1,0,0,
      .                                         0,1,1,1,1,0,1,1,1,0,
      .                                         1,1,1,1,1,1,1,1,1,1,
      .                                         1,0,0
-#endif
 #ifdef INCA_AER
-     .                                              ,1,1,1,1,1,1,1,1
+     .                                         ,1,1,1,1,0,1,1,1
+#endif
+#endif
+#ifdef INCA_AER
+c aerosol tracers
+     .                                        ,1,0,1,1,1,1,1,1,0,1,
+     .                                         0,1,1,1,1,1,0,1,0,1,1,1
+#endif
+#ifdef INCA_NMHC
+     .                                                 , 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+     .                                          1, 1, 1, 1, 1, 1, 1
 #endif
      .                                         /)
@@ -424,7 +472,10 @@
 
 #ifdef INCA_AER
+
+! Changement Anne 01/04/2005
         CALL aerosolmain (tr_seri,
      $                 pdtphys,
      $                 pplay,
+     $                 pdel,
      $                 prfl,
      $                 pmflxr,
@@ -435,6 +486,11 @@
      $                 ibas_con,
      $                 pphi,
-     $                 airephy,
-     $                 nstep)
+     $                 airephy, ! paire,
+     $                 nstep,
+     $                 rneb,         ! for chimiaq
+     $                 t_seri,       ! for chimiaq
+     $                 rh)
+! fin changement anne
+
 #endif
 
@@ -450,5 +506,6 @@
      $                 pplay,      !pmid
      $                 pdel,       !pdel
-     $                 pctsrf(1,3),!oro
+     $                 airephy,
+     $                 pctsrf(1,1),!oro
      $                 ftsol,      !tsurf
      $                 albsol,     !albs
@@ -485,5 +542,5 @@
 
 c Abder
-      if(nqmax.gt.2) aerosol(3)=.true.
+ctestmaf      if(nqmax.gt.2) aerosol(3)=.true.
 
        do i=1,nlon
@@ -505,8 +562,8 @@
 c======================================================================
 c     print*,'Avant convection'
-      do it=1,nqmax
-         WRITE(itn,'(i2)') it
+c      do it=1,nqmax
+c         WRITE(itn,'(i2)') it
 c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
-      enddo
+c      enddo
 
       if (convection) then
@@ -517,12 +574,19 @@
       IF ( conv_flg(it) == 0 ) CYCLE
 #endif
+      if (iflag_con.eq.2) then
+c tiedke
       CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     .            pplay, paprs, tr_seri(1,1,it), d_tr_cv)
+     .            pplay, paprs, tr_seri(1,1,it), d_tr_cv(1,1,it))
+      else if (iflag_con.eq.3) then
+c KE
+      call cvltr(pdtphys, da, phi, mp, paprs,pplay, tr_seri(1,1,it),
+     .           upwd,dnwd,d_tr_cv(1,1,it))
+      endif
+
       DO k = 1, nlev
       DO i = 1, klon
-         tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k)
+         tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it)
       ENDDO
       ENDDO
-c      WRITE(itn,'(i1)') it
 #ifdef INCA
       CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it = '
@@ -541,4 +605,63 @@
 c      enddo
 
+
+c======================================================================
+c   Calcul de l'effet des thermiques
+c======================================================================
+
+      do k=1,klev
+         do i=1,klon
+            zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg
+         enddo
+      enddo
+
+c      print*,'masse dans ph ',zmasse
+      do it=1,nqmax
+         do k=1,klev
+            do i=1,klon
+               d_tr_th(i,k,it)=0.
+               tr_seri(i,k,it)=max(tr_seri(i,k,it),0.)
+               tr_seri(i,k,it)=min(tr_seri(i,k,it),1.e10)
+            enddo
+         enddo
+      enddo
+
+      if (thermiques) then
+        print*,'calcul de leffet des thermiques'
+        nsplit=10
+        DO it=1, nqmax
+c        WRITE(itn,'(i1)') it
+c        CALL minmaxqfi(tr_seri(1,1,it),1.e10,-1.e33,'conv it='//itn)
+c	     print*,'avant dqthermiquesretro'
+c             call dump2d(iim,jjm-1,tr_seri(2,1,1),'TR_SERI      ')
+
+         do isplit=1,nsplit
+c  Abderr 25 11 02
+C Thermiques 
+c	print*,'Avant dans phytrac',avant
+            call dqthermcell(klon,klev,pdtphys/nsplit
+     .       ,fm_therm,entr_therm,zmasse
+     .       ,tr_seri(1:klon,1:klev,it),d_tr,ztra_th)
+
+            do k=1,klev
+               do i=1,klon
+                  d_tr(i,k)=pdtphys*d_tr(i,k)/nsplit
+                  d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k)
+                  tr_seri(i,k,it)=max(tr_seri(i,k,it)+d_tr(i,k),0.)
+               enddo
+            enddo
+          enddo ! nsplit
+          print*,'apres thermiques'
+c             call dump2d(iim,jjm-1,d_tr_th(1,1,1),'d_tr_th      ')
+c            do k=1,klev
+c	print*,'d_tr_th(',k,')=',tr_seri(280,k,1)
+c	   enddo
+
+c        WRITE(itn,'(i1)') it
+c        CALL minmaxqfi(tr_seri(1,1,it),1.e10,-1.e33,'therm it='//itn)
+       ENDDO ! it
+       endif ! Thermiques
+c       print*,'ATTENTION: sdans thermniques'
+      
 c======================================================================
 c   Calcul de l'effet de la couche limite
@@ -572,8 +695,8 @@
      e                    tautr(it),vdeptr(it),
      e                    xlat,
-     s                    d_tr_cl,d_trs)
+     s                    d_tr_cl(1,1,it),d_trs)
           DO k = 1, nlev
             DO i = 1, klon
-              tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k)
+              tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
             ENDDO
           ENDDO
@@ -604,11 +727,10 @@
      s               tr_seri(1,1,it), source,
      e               paprs, pplay, delp,
-     s               d_tr )
+     s               d_tr_cl(1,1,it))
             DO k = 1, nlev
                DO i = 1, klon
-                  tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k)
+                  tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cl(i,k,it)
                ENDDO
             ENDDO
-Cmaf provisoire suppression des prints
 Cmaf          WRITE(itn,'(i1)') it
 cmaf          CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracn it='//itn)
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/raddim.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/raddim.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/raddim.h	(revision 633)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Header $
 !
       INTEGER kdlon, kflev
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/radlwsw.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/radlwsw.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/radlwsw.F	(revision 633)
@@ -166,4 +166,9 @@
       REAL*8 ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect
 cjq-end
+!rv
+      tauae(:,:,:)=0.
+      pizae(:,:,:)=0.
+      cgae(:,:,:)=0.
+!rv
       
 c
@@ -546,6 +551,15 @@
       REAL*8 ZFSUPAI(KDLON,KFLEV+1)
       REAL*8 ZFSDNAI(KDLON,KFLEV+1)
+      logical initialized
       SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes
+!rv
+      save flag_aer
+      data initialized/.false./
 cjq-end
+      if(.not.initialized) then
+        flag_aer=0.
+        initialized=.TRUE.
+      endif
+!rv
       
 c
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/read_pstoke.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/read_pstoke.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/read_pstoke.F	(revision 633)
@@ -7,5 +7,14 @@
      .   zrec,zklono,zklevo,airefi,phisfi,
      .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
+     .   fm_therm,en_therm,
      .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
+
+C******************************************************************************
+C  Frederic HOURDIN, Abderrahmane IDELKADI
+C Lecture des parametres physique stockes online necessaires pour
+C recalculer offline le transport de traceurs sur une grille 2x plus fine que 
+C celle online 
+C A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
+C******************************************************************************
 
 
@@ -26,28 +35,31 @@
 #include "dimphy.h"
 	
-	  integer*4 klono,klevo,imo,jmo
+	  integer klono,klevo,imo,jmo
 	  parameter (imo=iim/2,jmo=(jjm+1)/2)
 	  parameter(klono=(jmo-1)*imo+2,klevo=llm)
-	  REAL*4 phisfi(klono)
-          REAL*4 phisfi2(imo,jmo+1),airefi2(imo,jmo+1)
-
-          REAL*4 mfu(klono,klevo), mfd(klono,klevo)
-          REAL*4 en_u(klono,klevo), de_u(klono,klevo)
-          REAL*4 en_d(klono,klevo), de_d(klono,klevo)
-          REAL*4 coefh(klono,klevo)
-
-          REAL*4 mfu2(imo,jmo+1,klevo), mfd2(imo,jmo+1,klevo)
-          REAL*4 en_u2(imo,jmo+1,klevo), de_u2(imo,jmo+1,klevo)
-          REAL*4 en_d2(imo,jmo+1,klevo), de_d2(imo,jmo+1,klevo)
-          REAL*4 coefh2(imo,jmo+1,klevo)
-
-          REAL*4 pl(klevo)
+	  REAL phisfi(klono)
+          REAL phisfi2(imo,jmo+1),airefi2(imo,jmo+1)
+
+          REAL mfu(klono,klevo), mfd(klono,klevo)
+          REAL en_u(klono,klevo), de_u(klono,klevo)
+          REAL en_d(klono,klevo), de_d(klono,klevo)
+          REAL coefh(klono,klevo)
+           REAL fm_therm(klono,klevo),en_therm(klono,klevo)
+
+          REAL mfu2(imo,jmo+1,klevo), mfd2(imo,jmo+1,klevo)
+          REAL en_u2(imo,jmo+1,klevo), de_u2(imo,jmo+1,klevo)
+          REAL en_d2(imo,jmo+1,klevo), de_d2(imo,jmo+1,klevo)
+          REAL coefh2(imo,jmo+1,klevo)
+           REAL fm_therm2(imo,jmo+1,klevo)
+           REAL en_therm2(imo,jmo+1,klevo)
+
+          REAL pl(klevo)
           integer irec
-          integer*4 xid,yid,zid,tid
+          integer xid,yid,zid,tid
           real zrec,zklono,zklevo,zim,zjm
-          integer*4 ncrec,ncklono,ncklevo,ncim,ncjm
-
-          real*4 airefi(klono)
-          character namedim
+          integer ncrec,ncklono,ncklevo,ncim,ncjm
+
+          real airefi(klono)
+          character*20 namedim
 
 c  !! attention !!
@@ -56,20 +68,20 @@
 	  
 	 
-          REAL*4 frac_impa(klono,klevo), frac_nucl(klono,klevo)
-          REAL*4 frac_impa2(imo,jmo+1,klevo), 
+          REAL frac_impa(klono,klevo), frac_nucl(klono,klevo)
+          REAL frac_impa2(imo,jmo+1,klevo), 
      .     frac_nucl2(imo,jmo+1,klevo)
-          REAL*4 pyu1(klono), pyv1(klono)
-          REAL*4 pyu12(imo,jmo+1), pyv12(imo,jmo+1)
-          REAL*4 ftsol(klono,nbsrf)
-          REAL*4 psrf(klono,nbsrf) 
-	  REAL*4 ftsol1(klono),ftsol2(klono),ftsol3(klono),ftsol4(klono)
-          REAL*4 psrf1(klono),psrf2(klono),psrf3(klono),psrf4(klono)
-          REAL*4 ftsol12(imo,jmo+1),ftsol22(imo,jmo+1),
+          REAL pyu1(klono), pyv1(klono)
+          REAL pyu12(imo,jmo+1), pyv12(imo,jmo+1)
+          REAL ftsol(klono,nbsrf)
+          REAL psrf(klono,nbsrf) 
+	  REAL ftsol1(klono),ftsol2(klono),ftsol3(klono),ftsol4(klono)
+          REAL psrf1(klono),psrf2(klono),psrf3(klono),psrf4(klono)
+          REAL ftsol12(imo,jmo+1),ftsol22(imo,jmo+1),
      .     ftsol32(imo,jmo+1),
      .     ftsol42(imo,jmo+1)
-          REAL*4 psrf12(imo,jmo+1),psrf22(imo,jmo+1),psrf32(imo,jmo+1),
+          REAL psrf12(imo,jmo+1),psrf22(imo,jmo+1),psrf32(imo,jmo+1),
      .     psrf42(imo,jmo+1)
-		REAL*4 t(klono,klevo)
-		REAL*4 t2(imo,jmo+1)	
+		REAL t(klono,klevo)
+		REAL t2(imo,jmo+1,klevo)	
 	  integer ncidp
           save ncidp
@@ -77,4 +89,5 @@
           integer varidmfu, varidmfd, varidps, varidenu, variddeu	
           integer varidend,varidded,varidch,varidfi,varidfn
+           integer varidfmth,varidenth
           integer varidyu1,varidyv1,varidpl,varidai,varididvt
           integer varidfts1,varidfts2,varidfts3,varidfts4
@@ -82,4 +95,5 @@
           save varidmfu, varidmfd, varidps, varidenu, variddeu
           save varidend,varidded,varidch,varidfi,varidfn
+           save varidfmth,varidenth
           save varidyu1,varidyv1,varidpl,varidai,varididvt
           save varidfts1,varidfts2,varidfts3,varidfts4
@@ -113,6 +127,8 @@
             print*,'ncidp,varidai',ncidp,varidai
 
+c A FAIRE: Es-il necessaire de stocke t?
 	        varidt=NCVID(ncidp,'t',rcode)
                 print*,'ncidp,varidt',ncidp,varidt
+
             varidmfu=NCVID(ncidp,'mfu',rcode)
             print*,'ncidp,varidmfu',ncidp,varidmfu
@@ -136,4 +152,11 @@
             print*,'ncidp,varidch',ncidp,varidch
 	
+c abder (pour thermiques)
+             varidfmth=NCVID(ncidp,'fm_th',rcode)
+             print*,'ncidp,varidfmth',ncidp,varidfmth
+
+             varidenth=NCVID(ncidp,'en_th',rcode)
+             print*,'ncidp,varidenth',ncidp,varidenth
+
 	    varidfi=NCVID(ncidp,'frac_impa',rcode)
             print*,'ncidp,varidfi',ncidp,varidfi
@@ -200,6 +223,9 @@
 
 c niveaux de pression
-
-            status=NF_GET_VARA_REAL(ncidp,varidpl,1,zklevo,pl)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpl,1,zklevo,pl)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidpl,1,zklevo,pl)
+#endif
 
 c lecture de aire et phis
@@ -216,15 +242,17 @@
 
 c phis
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,phisfi2)
-c      call dump2d(iip1-1,jjp1,phisfi2,'PHISNC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,phisfi2,phisfi)
 
 c aire
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
-c      call correctbid(iim,jjp1*1,airefi2)
-c       call dump2d(iip1-1,jjp1,airefi2,'AIRENC')
+#endif
        call gr_ecrit_fi(1,klono,imo,jmo+1,airefi2,airefi)
       else
@@ -249,165 +277,190 @@
       count(4)=1
 
+
+C *** Lessivage******************************************************
 c frac_impa 
-
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,frac_impa2)
-c      call dump2d(iip1-1,jjp1,frac_impa2,'FINC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,frac_impa2,frac_impa)
 
 c frac_nucl 
-
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,frac_nucl2)
-c      call dump2d(iip1-1,jjp1,frac_nucl2,'FINC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,frac_nucl2,frac_nucl)
 
+C*** Temperature ******************************************************
 c abder t
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,t2,t)
 
+C*** Flux pour le calcul de la convection TIEDTK ***********************
 c mfu
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,mfu2)
-c      call dump2d(iip1-1,jjp1,mfu2,'MFUNC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,mfu2,mfu)
 
 c mfd
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,mfd2)
-c      call dump2d(iip1-1,jjp1,mfd2,'MFDNC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,mfd2,mfd)
 
 c en_u 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,en_u2)
-c      call dump2d(iip1-1,jjp1,en_u2,'ENUNC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_u2,en_u)
 
 c de_u 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
+#else
       status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,de_u2)
-c      call dump2d(iip1-1,jjp1,de_u2,'DEUNC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,de_u2,de_u)
 
 c en_d 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,en_d2)
-c      call dump2d(iip1-1,jjp1,en_d2,'ENDNC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_d2,en_d)
 
 c de_d 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,de_d2)
-c      call dump2d(iip1-1,jjp1,de_d2,'DEDNC COUCHE 1')
+#endif
       call gr_ecrit_fi(klevo,klono,imo,jmo+1,de_d2,de_d)
 
+C **** Coeffecient du mellange turbulent**********************************
 c coefh 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*klevo,coefh2)
-c      call dump2d(iip1-1,jjp1,coefh2,'CHNC COUCHE 1')
+#endif
        call gr_ecrit_fi(klevo,klono,imo,jmo+1,coefh2,coefh)
 
+C*** Flux ascendant et entrant pour les Thermiques************************
+cabder thermiques
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfmth,start,count,fm_therm2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfmth,start,count,fm_therm2)
+#endif
+      call gr_ecrit_fi(klevo,klono,imo,jmo+1,fm_therm2,fm_therm)
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidenth,start,count,en_therm2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidenth,start,count,en_therm2)
+#endif
+      call gr_ecrit_fi(klevo,klono,imo,jmo+1,en_therm2,en_therm)
+
+C*** Vitesses aux sol ******************************************************
       start(3)=irec
       start(4)=0
       count(3)=1
       count(4)=0
-
 c pyu1
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,pyu12)
-c      call dump2d(iip1-1,jjp1,pyu12,'PYU1NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,pyu12,pyu1)
 
 c pyv1
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,pyv12)
-c      call dump2d(iip1-1,jjp1,pyv12,'PYV1NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,pyv12,pyv1)
 
+C*** Temperature au sol ********************************************
 c ftsol1
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol12)
-c      call dump2d(iip1-1,jjp1,ftsol12,'FTS1NC')
+#endif
        call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol12,ftsol1)
 
 c ftsol2
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol22)
-c      call dump2d(iip1-1,jjp1,ftsol22,'FTS2NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol22,ftsol2)
 
 c ftsol3
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol32)
-c      call dump2d(iip1-1,jjp1,ftsol32,'FTS3NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol32,ftsol3)
 
 c ftsol4
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,ftsol42)
-c      call dump2d(iip1-1,jjp1,ftsol42,'FTS4NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,ftsol42,ftsol4)
 
+C*** Nature du sol **************************************************
 c psrf1 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf12)
-c      call dump2d(iip1-1,jjp1,psrf12,'PSRF1NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,psrf12,psrf1)
 
 c psrf2 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf22)
-c      call dump2d(iip1-1,jjp1,psrf22,'PSRF2NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,psrf22,psrf2)
 
 c psrf3 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf32)
-c      call dump2d(iip1-1,jjp1,psrf32,'PSRF3NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,psrf32,psrf3)
 
 c psrf4 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
-c      print*,'WARNING!!! Correction bidon pour palier a un '
-c      print*,'probleme dans la creation des fichiers nc'
-c      call correctbid(iim,jjp1*1,psrf42)
-c      call dump2d(iip1-1,jjp1,psrf42,'PSRF4NC')
+#endif
       call gr_ecrit_fi(1,klono,imo,jmo+1,psrf42,psrf4)
 	
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/read_pstoke0.F
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/read_pstoke0.F	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/read_pstoke0.F	(revision 633)
@@ -7,5 +7,13 @@
      .   zrec,zkon,zkev,airefi,phisfi,
      .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
+     .   fm_therm,en_therm,
      .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
+
+C******************************************************************************
+C  Frederic HOURDIN, Abderrahmane IDELKADI
+C Lecture des parametres physique stockes online necessaires pour
+C recalculer offline le transport des traceurs sur la meme grille que online
+C A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)!
+C******************************************************************************
 
 
@@ -26,29 +34,36 @@
 #include "dimphy.h"
 	  
-	  integer*4 kon,kev,zkon,zkev
+	  integer kon,kev,zkon,zkev
 	  parameter(kon=iim*(jjm-1)+2,kev=llm)
-	  REAL*4 phisfi(kon)
-          REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
-
-          REAL*4 mfu(kon,kev), mfd(kon,kev)
-          REAL*4 en_u(kon,kev), de_u(kon,kev)
-          REAL*4 en_d(kon,kev), de_d(kon,kev)
-          REAL*4 coefh(kon,kev)
-		REAL*4 t(kon,kev)
-
-          REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
-          REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
-          REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
-          REAL*4 coefh2(iim,jjm+1,kev)
-		REAL*4 t2(iim,jjm+1,kev)
-
-          REAL*4 pl(kev)
+	  REAL phisfi(kon)
+          REAL phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
+
+          REAL mfu(kon,kev), mfd(kon,kev)
+          REAL en_u(kon,kev), de_u(kon,kev)
+          REAL en_d(kon,kev), de_d(kon,kev)
+          REAL coefh(kon,kev)
+
+c abd 25 11 02
+c Thermiques
+	 REAL fm_therm(kon,kev),en_therm(kon,kev)
+		REAL t(kon,kev)
+
+          REAL mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
+          REAL en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
+          REAL en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
+          REAL coefh2(iim,jjm+1,kev)
+		REAL t2(iim,jjm+1,kev)
+c Thermiques
+	 REAL fm_therm2(iim,jjm+1,kev)
+         REAL en_therm2(iim,jjm+1,kev)       
+
+          REAL pl(kev)
           integer irec
-          integer*4 xid,yid,zid,tid
-          integer*4 zrec,zim,zjm
-          integer*4 ncrec,nckon,nckev,ncim,ncjm
-
-          real*4 airefi(kon)
-          character namedim
+          integer xid,yid,zid,tid
+          integer zrec,zim,zjm
+          integer ncrec,nckon,nckev,ncim,ncjm
+
+          real airefi(kon)
+          character*20 namedim
 
 c  !! attention !!
@@ -56,17 +71,17 @@
 c dim de phis??
 
-          REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev)
-          REAL*4 frac_impa2(iim,jjm+1,kev), 
+          REAL frac_impa(kon,kev), frac_nucl(kon,kev)
+          REAL frac_impa2(iim,jjm+1,kev), 
      .     frac_nucl2(iim,jjm+1,kev)
-          REAL*4 pyu1(kon), pyv1(kon)
-          REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1)
-          REAL*4 ftsol(kon,nbsrf)
-          REAL*4 psrf(kon,nbsrf) 
-	  REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
-          REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
-          REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
+          REAL pyu1(kon), pyv1(kon)
+          REAL pyu12(iim,jjm+1), pyv12(iim,jjm+1)
+          REAL ftsol(kon,nbsrf)
+          REAL psrf(kon,nbsrf) 
+	  REAL ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
+          REAL psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
+          REAL ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
      .     ftsol32(iim,jjm+1),
      .     ftsol42(iim,jjm+1)
-          REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
+          REAL psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
      .     psrf42(iim,jjm+1)
 	
@@ -76,4 +91,6 @@
 		integer varidt
           integer varidend,varidded,varidch,varidfi,varidfn
+c therm
+	  integer varidfmth,varidenth
           integer varidyu1,varidyv1,varidpl,varidai,varididvt
           integer varidfts1,varidfts2,varidfts3,varidfts4
@@ -82,4 +99,6 @@
 		save varidt
           save varidend,varidded,varidch,varidfi,varidfn
+c therm
+	   save varidfmth,varidenth
           save varidyu1,varidyv1,varidpl,varidai,varididvt
           save varidfts1,varidfts2,varidfts3,varidfts4
@@ -112,10 +131,10 @@
             print*,'ncidp,varidai',ncidp,varidai
 
+                varidt=NCVID(ncidp,'t',rcode)
+                print*,'ncidp,varidt',ncidp,varidt
+
             varidmfu=NCVID(ncidp,'mfu',rcode)
             print*,'ncidp,varidmfu',ncidp,varidmfu
 
-		varidt=NCVID(ncidp,'t',rcode)
-                print*,'ncidp,varidt',ncidp,varidt
-
             varidmfd=NCVID(ncidp,'mfd',rcode)
             print*,'ncidp,varidmfd',ncidp,varidmfd
@@ -135,4 +154,11 @@
             varidch=NCVID(ncidp,'coefh',rcode)
             print*,'ncidp,varidch',ncidp,varidch
+
+c Thermiques
+            varidfmth=NCVID(ncidp,'fm_th',rcode)
+            print*,'ncidp,varidfmth',ncidp,varidfmth
+
+            varidenth=NCVID(ncidp,'en_th',rcode)
+            print*,'ncidp,varidenth',ncidp,varidenth
 	
 	    varidfi=NCVID(ncidp,'frac_impa',rcode)
@@ -216,10 +242,20 @@
 
 c 
+C**** Geopotentiel au sol ***************************************
 c phis
-      status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
 
+C**** Aires des mails aux sol ************************************
 c aire
-      status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
       else
@@ -244,46 +280,116 @@
       count(4)=1
 
-c frac_impa 
-
-      status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
-
-c frac_nucl 
-
-      status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
-      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
+C**** Temperature ********************************************
+cA FAIRE : Es-ce necessaire ?
 
 c abder t
-      status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
 
+C**** Flux pour la convection (Tiedtk) ********************************************
 c mfu
-      status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
 
 c mfd
-      status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
 
 c en_u 
-      status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
 
 c de_u 
-      status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
 
 c en_d 
-      status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
 
 c de_d 
-      status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
+#endif
       call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
 
+C**** Coefficient de mellange turbulent *******************************************
 c coefh 
 	print*,'LECTURE de coefh a irec =',irec
-       status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
+#endif
        call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
+c      call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ   ')
+c      call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ   ')
+
+C**** Flux ascendants et entrant dans le thermique **********************************
+cThermiques
+       print*,'LECTURE de fm_therm a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfmth,start,
+     .                         count,fm_therm2)
+#else
+       status=NF_GET_VARA_REAL(ncidp,varidfmth,start,
+     .                         count,fm_therm2)
+#endif
+       call gr_ecrit_fi(kev,kon,iim,jjm+1,fm_therm2,fm_therm)
+       print*,'LECTURE de en_therm a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidenth,start,
+     .                          count,en_therm2)
+#else
+       status=NF_GET_VARA_REAL(ncidp,varidenth,start,
+     .                          count,en_therm2)
+#endif
+       call gr_ecrit_fi(kev,kon,iim,jjm+1,en_therm2,en_therm)
+
+C**** Coefficients de lessivage *******************************************
+c frac_impa
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
+
+c frac_nucl
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
+
+C**** Vents aux sol ********************************************
 
       start(3)=irec
@@ -294,47 +400,89 @@
 c pyu1
 	print*,'LECTURE de yu1 a irec =',irec
-      status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
 
 c pyv1
         print*,'LECTURE de yv1 a irec =',irec
-      status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
+#else
+        status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
 
+C**** Temerature au sol ********************************************
 c ftsol1
         print*,'LECTURE de ftsol1 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
+#endif
        call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
 
 c ftsol2
         print*,'LECTURE de ftsol2 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
 
 c ftsol3
 	 print*,'LECTURE de ftsol3 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
 
 c ftsol4
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
 
+C**** Nature sol ********************************************
 c psrf1 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
+#endif
 c      call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
       call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
 
 c psrf2 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
+#endif
 c      call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
       call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
 
 c psrf3 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
 
 c psrf4 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
+#else
       status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
+#endif
       call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
 	
@@ -344,4 +492,6 @@
         psrf(i,2) = psrf2(i)
         psrf(i,3) = psrf3(i)
+c test abderr
+c	print*,'Dans read_pstoke psrf3 =',psrf3(i),i
         psrf(i,4) = psrf4(i)
   
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/stdlevvar.F90
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/stdlevvar.F90	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/stdlevvar.F90	(revision 633)
@@ -101,6 +101,10 @@
         ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
         zdte(i) = tpot(i) - ts1(i)
+!       PRINT*,'AVANT i,zdte',i,zdte(i)
 !IM cf FH : on prend le max : pour eviter le plantage sur SUN
-        zdte(i) = max(zdte(i),1.e-10)
+!IM BUG BUG BUG       zdte(i) = max(zdte(i),1.e-10)
+        zdte(i) = sign(max(abs(zdte(i)),1.e-10),zdte(i))
+!       PRINT*,'APRES i,zdte',i,zdte(i)
+!
         zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
 !
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/thermcell.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/thermcell.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/thermcell.F	(revision 633)
@@ -0,0 +1,1375 @@
+      SUBROUTINE thermcell(ngrid,nlay,ptimestep
+     s                  ,pplay,pplev,pphi
+     s                  ,pu,pv,pt,po
+     s                  ,pduadj,pdvadj,pdtadj,pdoadj
+     s                  ,fm0,entr0
+c    s                  ,pu_therm,pv_therm
+     s                  ,r_aspect,l_mix,w2di,tho)
+
+      IMPLICIT NONE
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c
+c   Réécriture à partir d'un listing papier à Habas, le 14/02/00
+c
+c   le thermique est supposé homogène et dissipé par mélange avec
+c   son environnement. la longueur l_mix contrôle l'efficacité du
+c   mélange
+c
+c   Le calcul du transport des différentes espèces se fait en prenant
+c   en compte:
+c     1. un flux de masse montant
+c     2. un flux de masse descendant
+c     3. un entrainement
+c     4. un detrainement
+c
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c   declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+
+c   arguments:
+c   ----------
+
+      INTEGER ngrid,nlay,w2di,tho
+      real ptimestep,l_mix,r_aspect
+      REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
+      REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
+      REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
+      REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
+      REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
+      real pphi(ngrid,nlay)
+
+      integer idetr
+      save idetr
+      data idetr/3/
+
+c   local:
+c   ------
+
+      INTEGER ig,k,l,lmaxa(klon),lmix(klon)
+      real zsortie1d(klon)
+c CR: on remplace lmax(klon,klev+1)
+      INTEGER lmax(klon),lmin(klon),lentr(klon)
+      real linter(klon)
+      real zmix(klon), fracazmix(klon) 
+c RC 
+      real zmax(klon),zw,zz,zw2(klon,klev+1),ztva(klon,klev),zzz
+
+      real zlev(klon,klev+1),zlay(klon,klev)
+      REAL zh(klon,klev),zdhadj(klon,klev)
+      REAL ztv(klon,klev)
+      real zu(klon,klev),zv(klon,klev),zo(klon,klev)
+      REAL wh(klon,klev+1)
+      real wu(klon,klev+1),wv(klon,klev+1),wo(klon,klev+1)
+      real zla(klon,klev+1)
+      real zwa(klon,klev+1)
+      real zld(klon,klev+1)
+      real zwd(klon,klev+1)
+      real zsortie(klon,klev)
+      real zva(klon,klev)
+      real zua(klon,klev)
+      real zoa(klon,klev)
+
+      real zha(klon,klev)
+      real wa_moy(klon,klev+1)
+      real fraca(klon,klev+1)
+      real fracc(klon,klev+1)
+      real zf,zf2
+      real thetath2(klon,klev),wth2(klon,klev)
+      common/comtherm/thetath2,wth2
+
+      real count_time
+      integer isplit,nsplit,ialt
+      parameter (nsplit=10)
+      data isplit/0/
+      save isplit
+
+      logical sorties
+      real rho(klon,klev),rhobarz(klon,klev+1),masse(klon,klev)
+      real zpspsk(klon,klev)
+
+c     real wmax(klon,klev),wmaxa(klon)
+      real wmax(klon),wmaxa(klon)
+      real wa(klon,klev,klev+1)
+      real wd(klon,klev+1)
+      real larg_part(klon,klev,klev+1)
+      real fracd(klon,klev+1)
+      real xxx(klon,klev+1)
+      real larg_cons(klon,klev+1)
+      real larg_detr(klon,klev+1)
+      real fm0(klon,klev+1),entr0(klon,klev),detr(klon,klev)
+      real pu_therm(klon,klev),pv_therm(klon,klev)
+      real fm(klon,klev+1),entr(klon,klev)
+      real fmc(klon,klev+1)
+
+cCR:nouvelles variables
+      real f_star(klon,klev+1),entr_star(klon,klev)
+      real entr_star_tot(klon),entr_star2(klon)
+      real f(klon), f0(klon)
+      real zlevinter(klon)
+      logical first
+      data first /.false./
+      save first
+cRC
+
+      character*2 str2
+      character*10 str10
+
+      LOGICAL vtest(klon),down
+
+      EXTERNAL SCOPY
+
+      integer ncorrec,ll
+      save ncorrec
+      data ncorrec/0/
+      
+c
+c-----------------------------------------------------------------------
+c   initialisation:
+c   ---------------
+c
+       sorties=.true.
+      IF(ngrid.NE.klon) THEN
+         PRINT*
+         PRINT*,'STOP dans convadj'
+         PRINT*,'ngrid    =',ngrid
+         PRINT*,'klon  =',klon
+      ENDIF
+c
+c-----------------------------------------------------------------------
+c   incrementation eventuelle de tendances precedentes:
+c   ---------------------------------------------------
+
+       print*,'0 OK convect8'
+
+      DO 1010 l=1,nlay
+         DO 1015 ig=1,ngrid
+            zpspsk(ig,l)=(pplay(ig,l)/pplev(ig,1))**RKAPPA
+            zh(ig,l)=pt(ig,l)/zpspsk(ig,l)
+            zu(ig,l)=pu(ig,l)
+            zv(ig,l)=pv(ig,l)
+            zo(ig,l)=po(ig,l)
+            ztv(ig,l)=zh(ig,l)*(1.+0.61*zo(ig,l))
+1015     CONTINUE
+1010  CONTINUE
+
+       print*,'1 OK convect8'
+c                       --------------------
+c
+c
+c                       + + + + + + + + + + +
+c
+c
+c  wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
+c  wh,wt,wo ...
+c
+c                       + + + + + + + + + + +  zh,zu,zv,zo,rho
+c
+c
+c                       --------------------   zlev(1)
+c                       \\\\\\\\\\\\\\\\\\\\
+c
+c
+
+c-----------------------------------------------------------------------
+c   Calcul des altitudes des couches
+c-----------------------------------------------------------------------
+
+      do l=2,nlay
+         do ig=1,ngrid
+            zlev(ig,l)=0.5*(pphi(ig,l)+pphi(ig,l-1))/RG
+         enddo
+      enddo
+      do ig=1,ngrid
+         zlev(ig,1)=0.
+         zlev(ig,nlay+1)=(2.*pphi(ig,klev)-pphi(ig,klev-1))/RG
+      enddo
+      do l=1,nlay
+         do ig=1,ngrid
+            zlay(ig,l)=pphi(ig,l)/RG
+         enddo
+      enddo
+
+c      print*,'2 OK convect8'
+c-----------------------------------------------------------------------
+c   Calcul des densites
+c-----------------------------------------------------------------------
+
+      do l=1,nlay
+         do ig=1,ngrid
+            rho(ig,l)=pplay(ig,l)/(zpspsk(ig,l)*RD*zh(ig,l))
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            rhobarz(ig,l)=0.5*(rho(ig,l)+rho(ig,l-1))
+         enddo
+      enddo
+
+      do k=1,nlay
+         do l=1,nlay+1
+            do ig=1,ngrid
+               wa(ig,k,l)=0.
+            enddo
+         enddo
+      enddo
+
+c      print*,'3 OK convect8'
+c------------------------------------------------------------------
+c   Calcul de w2, quarre de w a partir de la cape
+c   a partir de w2, on calcule wa, vitesse de l'ascendance
+c
+c   ATTENTION: Dans cette version, pour cause d'economie de memoire,
+c   w2 est stoke dans wa
+c
+c   ATTENTION: dans convect8, on n'utilise le calcule des wa
+c   independants par couches que pour calculer l'entrainement
+c   a la base et la hauteur max de l'ascendance.
+c
+c   Indicages:
+c   l'ascendance provenant du niveau k traverse l'interface l avec
+c   une vitesse wa(k,l).
+c
+c                       --------------------
+c
+c                       + + + + + + + + + + 
+c
+c  wa(k,l)   ----       --------------------    l
+c             /\
+c            /||\       + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||
+c             ||        + + + + + + + + + + 
+c             ||
+c             ||        --------------------
+c             ||__
+c             |___      + + + + + + + + + +     k
+c
+c                       --------------------
+c
+c
+c
+c------------------------------------------------------------------
+
+cCR: ponderation entrainement des couches instables
+cdef des entr_star tels que entr=f*entr_star      
+      do l=1,klev
+         do ig=1,ngrid 
+            entr_star(ig,l)=0.
+         enddo
+      enddo
+c determination de la longueur de la couche d entrainement
+      do ig=1,ngrid
+         lentr(ig)=1
+      enddo
+
+con ne considere que les premieres couches instables
+      do k=nlay-2,1,-1
+         do ig=1,ngrid
+            if (ztv(ig,k).gt.ztv(ig,k+1).and.
+     s          ztv(ig,k+1).le.ztv(ig,k+2)) then
+               lentr(ig)=k
+            endif
+          enddo
+      enddo
+    
+c determination du lmin: couche d ou provient le thermique
+      do ig=1,ngrid
+         lmin(ig)=1
+      enddo
+      do ig=1,ngrid
+         do l=nlay,2,-1
+            if (ztv(ig,l-1).gt.ztv(ig,l)) then
+               lmin(ig)=l-1
+            endif
+         enddo
+      enddo
+c
+c definition de l'entrainement des couches
+      do l=1,klev-1
+         do ig=1,ngrid 
+            if (ztv(ig,l).gt.ztv(ig,l+1).and.
+     s          l.ge.lmin(ig).and.l.le.lentr(ig)) then 
+                 entr_star(ig,l)=(ztv(ig,l)-ztv(ig,l+1))*
+     s                           (zlev(ig,l+1)-zlev(ig,l))
+            endif
+         enddo
+      enddo
+c pas de thermique si couches 1->5 stables
+      do ig=1,ngrid
+         if (lmin(ig).gt.5) then
+            do l=1,klev
+               entr_star(ig,l)=0.
+            enddo
+         endif
+      enddo 
+c calcul de l entrainement total
+      do ig=1,ngrid
+         entr_star_tot(ig)=0.
+      enddo
+      do ig=1,ngrid
+         do k=1,klev
+            entr_star_tot(ig)=entr_star_tot(ig)+entr_star(ig,k)
+         enddo
+      enddo
+c
+      print*,'fin calcul entr_star'
+      do k=1,klev
+         do ig=1,ngrid 
+            ztva(ig,k)=ztv(ig,k)
+         enddo
+      enddo
+cRC
+c      print*,'7 OK convect8'
+      do k=1,klev+1
+         do ig=1,ngrid
+            zw2(ig,k)=0.
+            fmc(ig,k)=0.
+cCR
+            f_star(ig,k)=0.
+cRC
+            larg_cons(ig,k)=0.
+            larg_detr(ig,k)=0.
+            wa_moy(ig,k)=0.
+         enddo
+      enddo
+
+c      print*,'8 OK convect8'
+      do ig=1,ngrid
+         linter(ig)=1.
+         lmaxa(ig)=1
+         lmix(ig)=1
+         wmaxa(ig)=0.
+      enddo
+
+cCR: 
+      do l=1,nlay-2
+         do ig=1,ngrid
+            if (ztv(ig,l).gt.ztv(ig,l+1)
+     s         .and.entr_star(ig,l).gt.1.e-10
+     s         .and.zw2(ig,l).lt.1e-10) then
+               f_star(ig,l+1)=entr_star(ig,l)
+ctest:calcul de dteta
+               zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+     s                     *0.4*pphi(ig,l)/(pphi(ig,l+1)-pphi(ig,l))
+               larg_detr(ig,l)=0.
+            else if ((zw2(ig,l).ge.1e-10).and.
+     s               (f_star(ig,l)+entr_star(ig,l).gt.1.e-10)) then
+               f_star(ig,l+1)=f_star(ig,l)+entr_star(ig,l)
+               ztva(ig,l)=(f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)
+     s                    *ztv(ig,l))/f_star(ig,l+1)
+               zw2(ig,l+1)=zw2(ig,l)*(f_star(ig,l)/f_star(ig,l+1))**2+
+     s                     2.*RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
+     s                     *(zlev(ig,l+1)-zlev(ig,l))
+            endif
+c determination de zmax continu par interpolation lineaire
+            if (zw2(ig,l+1).lt.0.) then
+ctest
+               if (abs(zw2(ig,l+1)-zw2(ig,l)).lt.1e-10) then
+                  print*,'pb linter'
+               endif
+               linter(ig)=(l*(zw2(ig,l+1)-zw2(ig,l))
+     s           -zw2(ig,l))/(zw2(ig,l+1)-zw2(ig,l))
+               zw2(ig,l+1)=0.
+               lmaxa(ig)=l
+            else
+               if (zw2(ig,l+1).lt.0.) then
+                  print*,'pb1 zw2<0'
+               endif
+               wa_moy(ig,l+1)=sqrt(zw2(ig,l+1))
+            endif
+            if (wa_moy(ig,l+1).gt.wmaxa(ig)) then
+c   lmix est le niveau de la couche ou w (wa_moy) est maximum
+               lmix(ig)=l+1
+               wmaxa(ig)=wa_moy(ig,l+1)
+            endif
+         enddo
+      enddo
+      print*,'fin calcul zw2'
+c
+c Calcul de la couche correspondant a la hauteur du thermique
+      do ig=1,ngrid
+         lmax(ig)=lentr(ig)
+      enddo
+      do ig=1,ngrid
+         do l=nlay,lentr(ig)+1,-1
+            if (zw2(ig,l).le.1.e-10) then
+               lmax(ig)=l-1
+            endif
+         enddo
+      enddo
+c pas de thermique si couches 1->5 stables
+      do ig=1,ngrid
+         if (lmin(ig).gt.5) then
+            lmax(ig)=1
+            lmin(ig)=1
+         endif
+      enddo 
+c    
+c Determination de zw2 max
+      do ig=1,ngrid
+         wmax(ig)=0.
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if (l.le.lmax(ig)) then
+                if (zw2(ig,l).lt.0.)then
+                  print*,'pb2 zw2<0'
+                endif
+                zw2(ig,l)=sqrt(zw2(ig,l))
+                wmax(ig)=max(wmax(ig),zw2(ig,l))
+            else
+                 zw2(ig,l)=0.
+            endif
+          enddo
+      enddo
+
+c   Longueur caracteristique correspondant a la hauteur des thermiques.
+      do  ig=1,ngrid
+         zmax(ig)=0.
+         zlevinter(ig)=zlev(ig,1)
+      enddo
+      do  ig=1,ngrid
+c calcul de zlevinter
+          zlevinter(ig)=(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*
+     s    linter(ig)+zlev(ig,lmax(ig))-lmax(ig)*(zlev(ig,lmax(ig)+1)
+     s    -zlev(ig,lmax(ig)))
+       zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
+      enddo
+
+      print*,'avant fermeture'
+c Fermeture,determination de f
+      do ig=1,ngrid
+         entr_star2(ig)=0.
+      enddo
+      do ig=1,ngrid
+         if (entr_star_tot(ig).LT.1.e-10) then
+            f(ig)=0.
+         else
+             do k=lmin(ig),lentr(ig)
+                entr_star2(ig)=entr_star2(ig)+entr_star(ig,k)**2
+     s                    /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k)))
+             enddo
+c Nouvelle fermeture
+             f(ig)=wmax(ig)/(max(500.,zmax(ig))*r_aspect
+     s             *entr_star2(ig))*entr_star_tot(ig)
+ctest
+c             if (first) then
+c             f(ig)=f(ig)+(f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)
+c     s             *wmax(ig))
+c             endif
+         endif
+c         f0(ig)=f(ig)
+c         first=.true.
+      enddo
+      print*,'apres fermeture'
+
+c Calcul de l'entrainement
+       do k=1,klev
+         do ig=1,ngrid 
+            entr(ig,k)=f(ig)*entr_star(ig,k)
+         enddo
+      enddo
+c Calcul des flux
+      do ig=1,ngrid
+         do l=1,lmax(ig)-1
+            fmc(ig,l+1)=fmc(ig,l)+entr(ig,l)
+         enddo
+      enddo
+
+cRC
+
+
+c      print*,'9 OK convect8'
+c     print*,'WA1 ',wa_moy
+
+c   determination de l'indice du debut de la mixed layer ou w decroit
+
+c   calcul de la largeur de chaque ascendance dans le cas conservatif.
+c   dans ce cas simple, on suppose que la largeur de l'ascendance provenant
+c   d'une couche est égale à la hauteur de la couche alimentante.
+c   La vitesse maximale dans l'ascendance est aussi prise comme estimation
+c   de la vitesse d'entrainement horizontal dans la couche alimentante.
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+               zw=max(wa_moy(ig,l),1.e-10)
+               larg_cons(ig,l)=zmax(ig)*r_aspect
+     s         *fmc(ig,l)/(rhobarz(ig,l)*zw)
+            endif
+         enddo
+      enddo
+
+      do l=2,nlay
+         do ig=1,ngrid
+            if (l.le.lmaxa(ig)) then
+c              if (idetr.eq.0) then
+c  cette option est finalement en dur.
+                  if ((l_mix*zlev(ig,l)).lt.0.)then
+                   print*,'pb l_mix*zlev<0'
+                  endif
+                  larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c              else if (idetr.eq.1) then
+c                 larg_detr(ig,l)=larg_cons(ig,l)
+c    s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
+c              else if (idetr.eq.2) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *sqrt(wa_moy(ig,l))
+c              else if (idetr.eq.4) then
+c                 larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
+c    s            *wa_moy(ig,l)
+c              endif
+            endif
+         enddo
+       enddo
+
+c      print*,'10 OK convect8'
+c     print*,'WA2 ',wa_moy
+c   calcul de la fraction de la maille concernée par l'ascendance en tenant
+c   compte de l'epluchage du thermique.
+c
+cCR def de  zmix continu (profil parabolique des vitesses)
+      do ig=1,ngrid
+           if (lmix(ig).gt.1.) then
+c test 
+              if (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))).gt.1e-10)
+     s        then
+c             
+            zmix(ig)=((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))**2-(zlev(ig,lmix(ig)+1))**2)
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))
+     s        /(2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))
+     s        *((zlev(ig,lmix(ig)))-(zlev(ig,lmix(ig)+1)))
+     s        -(zw2(ig,lmix(ig))-zw2(ig,lmix(ig)+1))
+     s        *((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
+            else
+            zmix(ig)=zlev(ig,lmix(ig))
+            print*,'pb zmix'
+            endif
+         else 
+         zmix(ig)=0.
+         endif
+ctest
+         if ((zmax(ig)-zmix(ig)).lt.0.) then
+            zmix(ig)=0.99*zmax(ig)
+c            print*,'pb zmix>zmax'
+         endif
+      enddo
+c
+c calcul du nouveau lmix correspondant
+      do ig=1,ngrid
+         do l=1,klev
+            if (zmix(ig).ge.zlev(ig,l).and.
+     s          zmix(ig).lt.zlev(ig,l+1)) then
+              lmix(ig)=l
+             endif
+          enddo
+      enddo
+c
+      do l=2,nlay
+         do ig=1,ngrid
+            if(larg_cons(ig,l).gt.1.) then
+c     print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
+               fraca(ig,l)=(larg_cons(ig,l)-larg_detr(ig,l))
+     s            /(r_aspect*zmax(ig))
+c test
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+            else
+c              wa_moy(ig,l)=0.
+               fraca(ig,l)=0.
+               fracc(ig,l)=0.
+               fracd(ig,l)=1.
+            endif
+         enddo
+      enddo                  
+cCR: calcul de fracazmix
+       do ig=1,ngrid
+          fracazmix(ig)=(fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/
+     s     (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig)
+     s    +fraca(ig,lmix(ig))-zlev(ig,lmix(ig))*(fraca(ig,lmix(ig)+1)
+     s    -fraca(ig,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
+       enddo
+c
+       do l=2,nlay
+          do ig=1,ngrid
+             if(larg_cons(ig,l).gt.1.) then
+               if (l.gt.lmix(ig)) then
+ctest
+                 if (zmax(ig)-zmix(ig).lt.1.e-10) then
+c                   print*,'pb xxx'
+                   xxx(ig,l)=(lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
+                 else
+                 xxx(ig,l)=(zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
+                 endif
+           if (idetr.eq.0) then
+               fraca(ig,l)=fracazmix(ig)
+           else if (idetr.eq.1) then
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)
+           else if (idetr.eq.2) then
+               fraca(ig,l)=fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
+           else
+               fraca(ig,l)=fracazmix(ig)*xxx(ig,l)**2
+           endif
+c     print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
+               fraca(ig,l)=max(fraca(ig,l),0.)
+               fraca(ig,l)=min(fraca(ig,l),0.5)
+               fracd(ig,l)=1.-fraca(ig,l)
+               fracc(ig,l)=larg_cons(ig,l)/(r_aspect*zmax(ig))
+             endif
+            endif
+         enddo
+      enddo
+      
+      print*,'fin calcul fraca'
+c      print*,'11 OK convect8'
+c     print*,'Ea3 ',wa_moy
+c------------------------------------------------------------------
+c   Calcul de fracd, wd
+c   somme wa - wd = 0
+c------------------------------------------------------------------
+
+
+      do ig=1,ngrid
+         fm(ig,1)=0.
+         fm(ig,nlay+1)=0.
+      enddo
+
+      do l=2,nlay
+           do ig=1,ngrid
+              fm(ig,l)=fraca(ig,l)*wa_moy(ig,l)*rhobarz(ig,l)
+cCR:test
+              if (entr(ig,l-1).lt.1e-10.and.fm(ig,l).gt.fm(ig,l-1)
+     s            .and.l.gt.lmix(ig)) then
+                 fm(ig,l)=fm(ig,l-1)
+c                 write(1,*)'ajustement fm, l',l
+              endif
+c              write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
+cRC
+           enddo
+         do ig=1,ngrid
+            if(fracd(ig,l).lt.0.1) then
+               stop'fracd trop petit'
+            else
+c    vitesse descendante "diagnostique"
+               wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l))
+            endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+c           masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
+            masse(ig,l)=(pplev(ig,l)-pplev(ig,l+1))/RG
+         enddo
+      enddo
+
+      print*,'12 OK convect8'
+c     print*,'WA4 ',wa_moy
+cc------------------------------------------------------------------
+c   calcul du transport vertical
+c------------------------------------------------------------------
+
+      go to 4444
+c     print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
+      do l=2,nlay-1
+         do ig=1,ngrid
+            if(fm(ig,l+1)*ptimestep.gt.masse(ig,l)
+     s      .and.fm(ig,l+1)*ptimestep.gt.masse(ig,l+1)) then
+c     print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
+c    s         ,fm(ig,l+1)*ptimestep
+c    s         ,'   M=',masse(ig,l),masse(ig,l+1)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(entr(ig,l)*ptimestep.gt.masse(ig,l)) then
+c     print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
+c    s         ,entr(ig,l)*ptimestep
+c    s         ,'   M=',masse(ig,l)
+             endif
+         enddo
+      enddo
+
+      do l=1,nlay
+         do ig=1,ngrid
+            if(.not.fm(ig,l).ge.0..or..not.fm(ig,l).le.10.) then
+c     print*,'WARN!!! fm exagere ig=',ig,'   l=',l
+c    s         ,'   FM=',fm(ig,l)
+            endif
+            if(.not.masse(ig,l).ge.1.e-10
+     s         .or..not.masse(ig,l).le.1.e4) then
+c     print*,'WARN!!! masse exagere ig=',ig,'   l=',l
+c    s         ,'   M=',masse(ig,l)
+c     print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
+c    s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
+c     print*,'zlev(ig,l+1),zlev(ig,l)'
+c    s                ,zlev(ig,l+1),zlev(ig,l)
+c     print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
+c    s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
+            endif
+            if(.not.entr(ig,l).ge.0..or..not.entr(ig,l).le.10.) then
+c     print*,'WARN!!! entr exagere ig=',ig,'   l=',l
+c    s         ,'   E=',entr(ig,l)
+            endif
+         enddo
+      enddo
+
+4444   continue
+
+cCR:redefinition du entr
+       do l=1,nlay
+         do ig=1,ngrid
+            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+            if (detr(ig,l).lt.0.) then
+                entr(ig,l)=entr(ig,l)-detr(ig,l)
+                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+            endif
+         enddo
+      enddo
+cRC
+      if (w2di.eq.1) then
+         fm0=fm0+ptimestep*(fm-fm0)/float(tho)
+         entr0=entr0+ptimestep*(entr-entr0)/float(tho)
+      else
+         fm0=fm
+         entr0=entr
+      endif
+
+      if (1.eq.1) then
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zh,zdhadj,zha)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zo,pdoadj,zoa)
+      else
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zh,zdhadj,zha)
+         call dqthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse,fraca
+     .    ,zo,pdoadj,zoa)
+      endif
+
+      if (1.eq.0) then
+         call dvthermcell2(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,fraca,zmax
+     .    ,zu,zv,pduadj,pdvadj,zua,zva)
+      else
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zu,pduadj,zua)
+         call dqthermcell(ngrid,nlay,ptimestep,fm0,entr0,masse
+     .    ,zv,pdvadj,zva)
+      endif
+
+      do l=1,nlay
+         do ig=1,ngrid
+            zf=0.5*(fracc(ig,l)+fracc(ig,l+1))
+            zf2=zf/(1.-zf)
+            thetath2(ig,l)=zf2*(zha(ig,l)-zh(ig,l))**2
+            wth2(ig,l)=zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
+         enddo
+      enddo
+
+
+
+c     print*,'13 OK convect8'
+c     print*,'WA5 ',wa_moy
+      do l=1,nlay
+         do ig=1,ngrid
+            pdtadj(ig,l)=zdhadj(ig,l)*zpspsk(ig,l)
+         enddo
+      enddo
+
+
+c     do l=1,nlay
+c        do ig=1,ngrid
+c           if(abs(pdtadj(ig,l))*86400..gt.500.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdtadj=',pdtadj(ig,l)
+c           endif
+c           if(abs(pdoadj(ig,l))*86400..gt.1.) then
+c     print*,'WARN!!! ig=',ig,'  l=',l
+c    s         ,'   pdoadj=',pdoadj(ig,l)
+c           endif
+c        enddo
+c      enddo
+
+      print*,'14 OK convect8'
+c------------------------------------------------------------------
+c   Calculs pour les sorties
+c------------------------------------------------------------------
+
+      if(sorties) then
+      do l=1,nlay
+         do ig=1,ngrid
+            zla(ig,l)=(1.-fracd(ig,l))*zmax(ig)
+            zld(ig,l)=fracd(ig,l)*zmax(ig)
+            if(1.-fracd(ig,l).gt.1.e-10)
+     s      zwa(ig,l)=wd(ig,l)*fracd(ig,l)/(1.-fracd(ig,l))
+         enddo
+      enddo
+
+cdeja fait
+c      do l=1,nlay
+c         do ig=1,ngrid
+c            detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
+c            if (detr(ig,l).lt.0.) then
+c                entr(ig,l)=entr(ig,l)-detr(ig,l)
+c                detr(ig,l)=0.
+c     print*,'WARNING !!! detrainement negatif ',ig,l
+c            endif
+c         enddo
+c      enddo
+
+c     print*,'15 OK convect8'
+
+      isplit=isplit+1
+
+
+c #define und
+	goto 123
+#ifdef und
+      CALL writeg1d(1,nlay,wd,'wd      ','wd      ')
+      CALL writeg1d(1,nlay,zwa,'wa      ','wa      ')
+      CALL writeg1d(1,nlay,fracd,'fracd      ','fracd      ')
+      CALL writeg1d(1,nlay,fraca,'fraca      ','fraca      ')
+      CALL writeg1d(1,nlay,wa_moy,'wam         ','wam         ')
+      CALL writeg1d(1,nlay,zla,'la      ','la      ')
+      CALL writeg1d(1,nlay,zld,'ld      ','ld      ')
+      CALL writeg1d(1,nlay,pt,'pt      ','pt      ')
+      CALL writeg1d(1,nlay,zh,'zh      ','zh      ')
+      CALL writeg1d(1,nlay,zha,'zha      ','zha      ')
+      CALL writeg1d(1,nlay,zu,'zu      ','zu      ')
+      CALL writeg1d(1,nlay,zv,'zv      ','zv      ')
+      CALL writeg1d(1,nlay,zo,'zo      ','zo      ')
+      CALL writeg1d(1,nlay,wh,'wh      ','wh      ')
+      CALL writeg1d(1,nlay,wu,'wu      ','wu      ')
+      CALL writeg1d(1,nlay,wv,'wv      ','wv      ')
+      CALL writeg1d(1,nlay,wo,'w15uo     ','wXo     ')
+      CALL writeg1d(1,nlay,zdhadj,'zdhadj      ','zdhadj      ')
+      CALL writeg1d(1,nlay,pduadj,'pduadj      ','pduadj      ')
+      CALL writeg1d(1,nlay,pdvadj,'pdvadj      ','pdvadj      ')
+      CALL writeg1d(1,nlay,pdoadj,'pdoadj      ','pdoadj      ')
+      CALL writeg1d(1,nlay,entr  ,'entr        ','entr        ')
+      CALL writeg1d(1,nlay,detr  ,'detr        ','detr        ')
+      CALL writeg1d(1,nlay,fm    ,'fm          ','fm          ')
+
+      CALL writeg1d(1,nlay,pdtadj,'pdtadj    ','pdtadj    ')
+      CALL writeg1d(1,nlay,pplay,'pplay     ','pplay     ')
+      CALL writeg1d(1,nlay,pplev,'pplev     ','pplev     ')
+
+c   recalcul des flux en diagnostique...
+c     print*,'PAS DE TEMPS ',ptimestep
+       call dt2F(pplev,pplay,pt,pdtadj,wh)
+      CALL writeg1d(1,nlay,wh,'wh2     ','wh2     ')
+#endif
+123   continue
+c#define troisD
+#ifdef troisD
+c       if (sorties) then
+      print*,'Debut des wrgradsfi'
+
+c      print*,'16 OK convect8'
+         call wrgradsfi(1,nlay,wd,'wd        ','wd        ')
+         call wrgradsfi(1,nlay,zwa,'wa        ','wa        ')
+         call wrgradsfi(1,nlay,fracd,'fracd     ','fracd     ')
+         call wrgradsfi(1,nlay,fraca,'fraca     ','fraca     ')
+         call wrgradsfi(1,nlay,xxx,'xxx       ','xxx       ')
+         call wrgradsfi(1,nlay,wa_moy,'wam       ','wam       ')
+c      print*,'WA6 ',wa_moy
+         call wrgradsfi(1,nlay,zla,'la        ','la        ')
+         call wrgradsfi(1,nlay,zld,'ld        ','ld        ')
+         call wrgradsfi(1,nlay,pt,'pt        ','pt        ')
+         call wrgradsfi(1,nlay,zh,'zh        ','zh        ')
+         call wrgradsfi(1,nlay,zha,'zha        ','zha        ')
+         call wrgradsfi(1,nlay,zua,'zua        ','zua        ')
+         call wrgradsfi(1,nlay,zva,'zva        ','zva        ')
+         call wrgradsfi(1,nlay,zu,'zu        ','zu        ')
+         call wrgradsfi(1,nlay,zv,'zv        ','zv        ')
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,wh,'wh        ','wh        ')
+         call wrgradsfi(1,nlay,wu,'wu        ','wu        ')
+         call wrgradsfi(1,nlay,wv,'wv        ','wv        ')
+         call wrgradsfi(1,nlay,wo,'wo        ','wo        ')
+         call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+         call wrgradsfi(1,nlay,zdhadj,'zdhadj    ','zdhadj    ')
+         call wrgradsfi(1,nlay,pduadj,'pduadj    ','pduadj    ')
+         call wrgradsfi(1,nlay,pdvadj,'pdvadj    ','pdvadj    ')
+         call wrgradsfi(1,nlay,pdoadj,'pdoadj    ','pdoadj    ')
+         call wrgradsfi(1,nlay,entr,'entr      ','entr      ')
+         call wrgradsfi(1,nlay,detr,'detr      ','detr      ')
+         call wrgradsfi(1,nlay,fm,'fm        ','fm        ')
+         call wrgradsfi(1,nlay,fmc,'fmc       ','fmc       ')
+         call wrgradsfi(1,nlay,zw2,'zw2       ','zw2       ')
+         call wrgradsfi(1,nlay,ztva,'ztva      ','ztva      ')
+         call wrgradsfi(1,nlay,ztv,'ztv       ','ztv       ')
+
+         call wrgradsfi(1,nlay,zo,'zo        ','zo        ')
+         call wrgradsfi(1,nlay,larg_cons,'Lc        ','Lc        ')
+         call wrgradsfi(1,nlay,larg_detr,'Ldetr     ','Ldetr     ')
+
+cCR:nouveaux diagnostiques
+      call wrgradsfi(1,nlay,entr_star  ,'entr_star   ','entr_star   ')     
+      call wrgradsfi(1,nlay,f_star    ,'f_star   ','f_star   ')
+      call wrgradsfi(1,1,zmax,'zmax      ','zmax      ')
+      call wrgradsfi(1,1,zmix,'zmix      ','zmix      ') 
+      zsortie1d(:)=lmax(:)
+      call wrgradsfi(1,1,zsortie1d,'lmax      ','lmax      ')
+      call wrgradsfi(1,1,wmax,'wmax      ','wmax      ')
+      zsortie1d(:)=lmix(:)
+      call wrgradsfi(1,1,zsortie1d,'lmix      ','lmix      ')
+      zsortie1d(:)=lentr(:)
+      call wrgradsfi(1,1,zsortie1d,'lentr      ','lentr     ')
+
+c      print*,'17 OK convect8'
+
+         do k=1,klev/10
+            write(str2,'(i2.2)') k
+            str10='wa'//str2
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=wa(ig,k,l)
+               enddo
+            enddo   
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+            do l=1,nlay
+               do ig=1,ngrid
+                  zsortie(ig,l)=larg_part(ig,k,l)
+               enddo
+            enddo
+            str10='la'//str2
+            CALL wrgradsfi(1,nlay,zsortie,str10,str10)
+         enddo
+
+
+c     print*,'18 OK convect8'
+c      endif
+      print*,'Fin des wrgradsfi'
+#endif
+
+      endif
+
+c     if(wa_moy(1,4).gt.1.e-10) stop
+
+      print*,'19 OK convect8'
+      return
+      end
+
+      subroutine dqthermcell(ngrid,nlay,ptimestep,fm,entr,masse
+     .    ,q,dq,qa)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay)
+      real q(ngrid,nlay)
+      real dq(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+               qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))
+     s         /(fm(ig,k+1)+detr(ig,k))
+            else
+               qa(ig,k)=q(ig,k)
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+c             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+            wqd(ig,k)=fm(ig,k)*q(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)
+     s               -wqd(ig,k)+wqd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+      subroutine dvthermcell(ngrid,nlay,ptimestep,fm,entr,masse
+     .    ,fraca,larga
+     .    ,u,v,du,dv,ua,va)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real fraca(ngrid,nlay+1)
+      real larga(ngrid)
+      real entr(ngrid,nlay)
+      real u(ngrid,nlay)
+      real ua(ngrid,nlay)
+      real du(ngrid,nlay)
+      real v(ngrid,nlay)
+      real va(ngrid,nlay)
+      real dv(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev)
+      real wvd(klon,klev+1),wud(klon,klev+1)
+      real gamma0,gamma(klon,klev+1)
+      real dua,dva
+      integer iter
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         ua(ig,1)=u(ig,1)
+         va(ig,1)=v(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+c   On itère sur la valeur du coeff de freinage.
+c              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+               gamma0=masse(ig,k)
+     s         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )
+     s         *0.5/larga(ig)
+c              gamma0=0.
+c   la première fois on multiplie le coefficient de freinage
+c   par le module du vent dans la couche en dessous.
+               dua=ua(ig,k-1)-u(ig,k-1)
+               dva=va(ig,k-1)-v(ig,k-1)
+               do iter=1,5
+                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
+                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)
+     s               +(entr(ig,k)+gamma(ig,k))*u(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
+                  va(ig,k)=(fm(ig,k)*va(ig,k-1)
+     s               +(entr(ig,k)+gamma(ig,k))*v(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+gamma(ig,k))
+c                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+                  dua=ua(ig,k)-u(ig,k)
+                  dva=va(ig,k)-v(ig,k)
+               enddo
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               gamma(ig,k)=0.
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wud(ig,k)=fm(ig,k)*u(ig,k)
+            wvd(ig,k)=fm(ig,k)*v(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wud(ig,1)=0.
+         wud(ig,nlay+1)=0.
+         wvd(ig,1)=0.
+         wvd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*u(ig,k)
+     s               -wud(ig,k)+wud(ig,k+1))
+     s               /masse(ig,k)
+            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*v(ig,k)
+     s               -wvd(ig,k)+wvd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+      subroutine dqthermcell2(ngrid,nlay,ptimestep,fm,entr,masse,frac
+     .    ,q,dq,qa)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real entr(ngrid,nlay),frac(ngrid,nlay)
+      real q(ngrid,nlay)
+      real dq(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev),wqd(klon,klev+1)
+      real qe(klon,klev),zf,zf2
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         qa(ig,1)=q(ig,1)
+         qe(ig,1)=q(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+               zf=0.5*(frac(ig,k)+frac(ig,k+1))
+               zf2=1./(1.-zf)
+               qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+zf2*entr(ig,k)*q(ig,k))
+     s         /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2)
+               qe(ig,k)=(q(ig,k)-zf*qa(ig,k))*zf2
+            else
+               qa(ig,k)=q(ig,k)
+               qe(ig,k)=q(ig,k)
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+c             wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k))
+            wqd(ig,k)=fm(ig,k)*qe(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wqd(ig,1)=0.
+         wqd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            dq(ig,k)=(detr(ig,k)*qa(ig,k)-entr(ig,k)*qe(ig,k)
+     s               -wqd(ig,k)+wqd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
+      subroutine dvthermcell2(ngrid,nlay,ptimestep,fm,entr,masse
+     .    ,fraca,larga
+     .    ,u,v,du,dv,ua,va)
+      implicit none
+
+c=======================================================================
+c
+c   Calcul du transport verticale dans la couche limite en presence
+c   de "thermiques" explicitement representes
+c   calcul du dq/dt une fois qu'on connait les ascendances
+c
+c=======================================================================
+
+#include "dimensions.h"
+#include "dimphy.h"
+
+      integer ngrid,nlay
+
+      real ptimestep
+      real masse(ngrid,nlay),fm(ngrid,nlay+1)
+      real fraca(ngrid,nlay+1)
+      real larga(ngrid)
+      real entr(ngrid,nlay)
+      real u(ngrid,nlay)
+      real ua(ngrid,nlay)
+      real du(ngrid,nlay)
+      real v(ngrid,nlay)
+      real va(ngrid,nlay)
+      real dv(ngrid,nlay)
+
+      real qa(klon,klev),detr(klon,klev),zf,zf2
+      real wvd(klon,klev+1),wud(klon,klev+1)
+      real gamma0,gamma(klon,klev+1)
+      real ue(klon,klev),ve(klon,klev)
+      real dua,dva
+      integer iter
+
+      integer ig,k
+
+c   calcul du detrainement
+
+      do k=1,nlay
+         do ig=1,ngrid
+            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
+         enddo
+      enddo
+
+c   calcul de la valeur dans les ascendances
+      do ig=1,ngrid
+         ua(ig,1)=u(ig,1)
+         va(ig,1)=v(ig,1)
+         ue(ig,1)=u(ig,1)
+         ve(ig,1)=v(ig,1)
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.
+     s         1.e-5*masse(ig,k)) then
+c   On itère sur la valeur du coeff de freinage.
+c              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
+               gamma0=masse(ig,k)
+     s         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )
+     s         *0.5/larga(ig)
+     s         *1.
+c    s         *0.5
+c              gamma0=0.
+               zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
+               zf=0.
+               zf2=1./(1.-zf)
+c   la première fois on multiplie le coefficient de freinage
+c   par le module du vent dans la couche en dessous.
+               dua=ua(ig,k-1)-u(ig,k-1)
+               dva=va(ig,k-1)-v(ig,k-1)
+               do iter=1,5
+c   On choisit une relaxation lineaire.
+                  gamma(ig,k)=gamma0
+c   On choisit une relaxation quadratique.
+                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
+                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)
+     s               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2
+     s                 +gamma(ig,k))
+                  va(ig,k)=(fm(ig,k)*va(ig,k-1)
+     s               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))
+     s               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2
+     s                 +gamma(ig,k))
+c                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
+                  dua=ua(ig,k)-u(ig,k)
+                  dva=va(ig,k)-v(ig,k)
+                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
+                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
+               enddo
+            else
+               ua(ig,k)=u(ig,k)
+               va(ig,k)=v(ig,k)
+               ue(ig,k)=u(ig,k)
+               ve(ig,k)=v(ig,k)
+               gamma(ig,k)=0.
+            endif
+         enddo
+      enddo
+
+      do k=2,nlay
+         do ig=1,ngrid
+            wud(ig,k)=fm(ig,k)*ue(ig,k)
+            wvd(ig,k)=fm(ig,k)*ve(ig,k)
+         enddo
+      enddo
+      do ig=1,ngrid
+         wud(ig,1)=0.
+         wud(ig,nlay+1)=0.
+         wvd(ig,1)=0.
+         wvd(ig,nlay+1)=0.
+      enddo
+
+      do k=1,nlay
+         do ig=1,ngrid
+            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)
+     s               -wud(ig,k)+wud(ig,k+1))
+     s               /masse(ig,k)
+            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)
+     s               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)
+     s               -wvd(ig,k)+wvd(ig,k+1))
+     s               /masse(ig,k)
+         enddo
+      enddo
+
+      return
+      end
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/thermcell.h
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/thermcell.h	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/thermcell.h	(revision 633)
@@ -0,0 +1,8 @@
+      integer iflag_thermals,nsplit_thermals
+      real r_aspect_thermals,l_mix_thermals,tho_thermals
+      integer w2di_thermals,isplit
+
+      common/ctherm/iflag_thermals,nsplit_thermals
+     s              ,r_aspect_thermals,l_mix_thermals,tho_thermals
+     s              ,w2di_thermals
+
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ustarhb.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ustarhb.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/ustarhb.F	(revision 633)
@@ -0,0 +1,53 @@
+!
+! $Header$
+!
+      SUBROUTINE ustarhb(knon,u,v,cd_m, ustar)
+      IMPLICIT none
+c======================================================================
+c Laurent Li (LMD/CNRS), le 30 septembre 1998
+c Couche limite non-locale. Adaptation du code du CCM3.
+c Code non teste, donc a ne pas utiliser.
+c======================================================================
+c Nonlocal scheme that determines eddy diffusivities based on a
+c diagnosed boundary layer height and a turbulent velocity scale.
+c Also countergradient effects for heat and moisture are included.
+c
+c For more information, see Holtslag, A.A.M., and B.A. Boville, 1993:
+c Local versus nonlocal boundary-layer diffusion in a global climate
+c model. J. of Climate, vol. 6, 1825-1842.
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c Arguments:
+c
+      INTEGER knon ! nombre de points a calculer
+      REAL u(klon,klev) ! vitesse U (m/s)
+      REAL v(klon,klev) ! vitesse V (m/s)
+      REAL cd_m(klon) ! coefficient de friction au sol pour vitesse
+      REAL ustar(klon)
+c
+      INTEGER i, k
+      REAL zxt, zxq, zxu, zxv, zxmod, taux, tauy
+      REAL zx_alf1, zx_alf2 ! parametres pour extrapolation
+      LOGICAL unssrf(klon)  ! unstb pbl w/lvls within srf pbl lyr
+      LOGICAL unsout(klon)  ! unstb pbl w/lvls in outer pbl lyr
+      LOGICAL check(klon)   ! True=>chk if Richardson no.>critcal
+c
+#include "YOETHF.h"
+#include "FCTTRE.h"
+      DO i = 1, knon
+        zx_alf1 = 1.0
+        zx_alf2 = 1.0 - zx_alf1
+        zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2
+        zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2
+        zxmod = 1.0+SQRT(zxu**2+zxv**2)
+        taux = zxu *zxmod*cd_m(i)
+        tauy = zxv *zxmod*cd_m(i)
+        ustar(i) = SQRT(taux**2+tauy**2)
+c       print*,'Ust ',zxu,zxmod,taux,ustar(i)
+      ENDDO
+c
+      return
+      end
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/vdif_kcay.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/vdif_kcay.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/vdif_kcay.F	(revision 633)
@@ -0,0 +1,739 @@
+!
+! $Header$
+!
+      SUBROUTINE vdif_kcay(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,q2diag,km,kn,ustar
+     s   ,l_mix)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c 
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon),snstable
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1),q2s(klon,klev+1)
+      REAL q2diag(klon,klev+1)
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      real sq(klon),sqz(klon),zz(klon,klev+1),zq,long0(klon)
+
+      integer l_mix,iii
+c.......................................................................
+c
+c nlay : nombre de couches        
+c nlev : nombre de niveaux
+c ngrid : nombre de points de grille       
+c unsdz : 1 sur l'epaisseur de couche
+c unsdzdec : 1 sur la distance entre le centre de la couche et le
+c            centre de la couche inferieure
+c q : echelle de vitesse au bas de chaque couche
+c     (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      INTEGER nlay,nlev,ngrid
+      REAL unsdz(klon,klev)
+      REAL unsdzdec(klon,klev+1)
+      REAL q(klon,klev+1)
+
+c.......................................................................
+c
+c kmpre : km au debut du pas de temps
+c qcstat : q : solution stationnaire du probleme couple
+c          (valeur a la fin du pas de temps)
+c q2cstat : q2 : solution stationnaire du probleme couple
+c           (valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL kmpre(klon,klev+1)
+      REAL qcstat
+      REAL q2cstat
+      real sss,sssq
+c.......................................................................
+c
+c long : longueur de melange calculee selon Blackadar
+c
+c.......................................................................
+      REAL long(klon,klev+1)
+c.......................................................................
+c
+c kmq3 : terme en q^3 dans le developpement de km
+c        (valeur au debut du pas de temps)
+c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c knq3 : terme en q^3 dans le developpement de kn
+c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
+c          (valeur a la fin du pas de temps)
+c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
+c           (valeur a la fin du pas de temps)
+c m : valeur a la fin du pas de temps
+c mpre : valeur au debut du pas de temps
+c m2 : valeur a la fin du pas de temps
+c n2 : valeur a la fin du pas de temps
+c 
+c.......................................................................
+      REAL kmq3
+      REAL kmcstat
+      REAL knq3
+      REAL mcstat
+      REAL m2cstat
+      REAL m(klon,klev+1)
+      REAL mpre(klon,klev+1)
+      REAL m2(klon,klev+1)
+      REAL n2(klon,klev+1)
+c.......................................................................
+c
+c gn : intermediaire pour les coefficients de stabilite
+c gnmin : borne inferieure de gn (-0.23 ou -0.28)
+c gnmax : borne superieure de gn (0.0233)
+c gninf : vrai si gn est en dessous de sa borne inferieure
+c gnsup : vrai si gn est en dessus de sa borne superieure
+c gm : drole d'objet bien utile
+c ri : nombre de Richardson
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c sm : coefficient de stabilite pour m
+c smq2 : premier terme du developement limite de sm en q2
+c
+c.......................................................................
+      REAL gn
+      REAL gnmin
+      REAL gnmax
+      LOGICAL gninf
+      LOGICAL gnsup
+      REAL gm
+c      REAL ri(klon,klev+1)
+      REAL sn(klon,klev+1)
+      REAL snq2(klon,klev+1)
+      REAL sm(klon,klev+1)
+      REAL smq2(klon,klev+1)
+c.......................................................................
+c
+c kappa : consatnte de Von Karman (0.4)
+c long00 : longueur de reference pour le calcul de long (160)
+c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
+c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
+c cn1,cn2 : constantes pour sn
+c cm1,cm2,cm3,cm4 : constantes pour sm
+c
+c.......................................................................
+      REAL kappa
+      REAL long00
+      REAL a1,a2,b1,b2,c1
+      REAL cn1,cn2
+      REAL cm1,cm2,cm3,cm4
+c.......................................................................
+c
+c termq : termes en $q$ dans l'equation de q2
+c termq3 : termes en $q^3$ dans l'equation de q2
+c termqm2 : termes en $q*m^2$ dans l'equation de q2
+c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
+c
+c.......................................................................
+      REAL termq
+      REAL termq3
+      REAL termqm2
+      REAL termq3m2
+c.......................................................................
+c
+c q2min : borne inferieure de q2
+c q2max : borne superieure de q2
+c
+c.......................................................................
+      REAL q2min
+      REAL q2max
+c.......................................................................
+c knmin : borne inferieure de kn
+c kmmin : borne inferieure de km
+c.......................................................................
+      REAL knmin
+      REAL kmmin
+c.......................................................................
+      INTEGER ilay,ilev,igrid
+      REAL tmp1,tmp2
+c.......................................................................
+      PARAMETER (kappa=0.4E+0)
+      PARAMETER (long00=160.E+0)
+c     PARAMETER (gnmin=-10.E+0)
+      PARAMETER (gnmin=-0.28)
+      PARAMETER (gnmax=0.0233E+0)
+      PARAMETER (a1=0.92E+0)
+      PARAMETER (a2=0.74E+0)
+      PARAMETER (b1=16.6E+0)
+      PARAMETER (b2=10.1E+0)
+      PARAMETER (c1=0.08E+0)
+      PARAMETER (knmin=1.E-5)
+      PARAMETER (kmmin=1.E-5)
+      PARAMETER (q2min=1.e-5)
+      PARAMETER (q2max=1.E+2)
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+c
+      PARAMETER (
+     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
+     &          )
+      PARAMETER (
+     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
+     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
+     &          )
+      PARAMETER (
+     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
+     &          )
+      PARAMETER (
+     &  cm4=-9.E+0 *a1*a2
+     &          )
+
+      logical first
+      save first
+      data first/.true./
+c.......................................................................
+c  traitment des valeur de q2 en entree
+c.......................................................................
+c
+c   Initialisation de q2
+
+      call yamada(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2diag,km,kn,ustar
+     s   ,l_mix)
+      if (first.and.1.eq.1) then
+      first=.false.
+      q2=q2diag
+      endif
+
+      DO ilev=1,nlev
+                                                      DO igrid=1,ngrid 
+        q2(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
+        q(igrid,ilev)=sqrt(q2(igrid,ilev))
+                                                      ENDDO
+      ENDDO
+c
+                                                      DO igrid=1,ngrid 
+      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
+      q2(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
+      q2(igrid,1)=amax1(q2(igrid,1),q2min)
+      q(igrid,1)=sqrt(q2(igrid,1))
+                                                      ENDDO
+c
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+                                                      DO igrid=1,ngrid 
+            zlev(igrid,nlev)=zlay(igrid,nlay)
+     &             +( zlay(igrid,nlay) - zlev(igrid,nlev-1) )
+                                                      ENDDO            
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO ilay=1,nlay
+                                                      DO igrid=1,ngrid 
+        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
+                                                      ENDDO
+      DO ilay=2,nlay
+                                                      DO igrid=1,ngrid 
+        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
+                                                      ENDDO
+      ENDDO
+                                                      DO igrid=1,ngrid 
+      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
+                                                      ENDDO
+c
+c.......................................................................
+c  le cisaillement et le gradient de temperature
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,1)=(unsdzdec(igrid,1)
+     &                   *u(igrid,1))**2
+     &                 +(unsdzdec(igrid,1)
+     &                   *v(igrid,1))**2
+      m(igrid,1)=sqrt(m2(igrid,1))
+      mpre(igrid,1)=m(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        n2(igrid,ilev)=g*unsdzdec(igrid,ilev)
+     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
+     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
+c       n2(igrid,ilev)=0.
+c
+c --->
+c       on ne sais traiter que les cas stratifies. et l'ajustement
+c       convectif est cense faire en sorte que seul des configurations
+c       stratifiees soient rencontrees en entree de cette routine.
+c       mais, bon ... on sait jamais (meme on sait que n2 prends
+c       quelques valeurs negatives ... parfois) alors : 
+c<---
+c
+        IF (n2(igrid,ilev).lt.0.E+0) THEN
+          n2(igrid,ilev)=0.E+0
+        ENDIF
+c
+        m2(igrid,ilev)=(unsdzdec(igrid,ilev)
+     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
+     &                   +(unsdzdec(igrid,ilev)
+     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
+        m(igrid,ilev)=sqrt(m2(igrid,ilev))
+        mpre(igrid,ilev)=m(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      m2(igrid,nlev)=m2(igrid,nlev-1)
+      m(igrid,nlev)=m(igrid,nlev-1)
+      mpre(igrid,nlev)=m(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  calcul des fonctions de stabilite
+c.......................................................................
+c
+      if (l_mix.eq.4) then
+                                                      DO igrid=1,ngrid 
+         sqz(igrid)=1.e-10
+         sq(igrid)=1.e-10
+                                                      ENDDO
+         do ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+           zq=sqrt(q2(igrid,ilev))
+           sqz(igrid)
+     .     =sqz(igrid)+zq*zlev(igrid,ilev)
+     .     *(zlay(igrid,ilev)-zlay(igrid,ilev-1))
+           sq(igrid)=sq(igrid)+zq*(zlay(igrid,ilev)-zlay(igrid,ilev-1))
+                                                      ENDDO
+         enddo
+                                                      DO igrid=1,ngrid 
+         long0(igrid)=0.2*sqz(igrid)/sq(igrid)
+                                                      ENDDO
+      else if (l_mix.eq.3) then
+         long0(igrid)=long00
+      endif
+
+c (abd 5 2)      print*,'LONG0=',long0
+
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
+        if (l_mix.ge.10) then
+            long(igrid,ilev)=l_mix
+        else
+           long(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0(igrid))
+        endif
+        long(igrid,ilev)=max(min(long(igrid,ilev)
+     s    ,0.5*sqrt(q2(igrid,ilev))/sqrt(max(n2(igrid,ilev),1.e-10)))
+     s    ,5.)
+
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        gm=long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * m2(igrid,ilev)
+c
+        gninf=.false.
+        gnsup=.false.
+        long(igrid,ilev)=long(igrid,ilev)
+        long(igrid,ilev)=long(igrid,ilev)
+c
+        IF (gn.lt.gnmin) THEN
+          gninf=.true.
+          gn=gnmin
+        ENDIF
+c
+        IF (gn.gt.gnmax) THEN
+          gnsup=.true.
+          gn=gnmax
+        ENDIF
+c
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)
+     &     *(1.E+0 +cm4*gn) )
+c
+        IF ((gninf).or.(gnsup)) THEN
+          snq2(igrid,ilev)=0.E+0
+          smq2(igrid,ilev)=0.E+0
+        ELSE
+          snq2(igrid,ilev)=
+     &     -gn
+     &     *(-cn1*cn2/(1.E+0 +cn2*gn)**2 )
+          smq2(igrid,ilev)=
+     &     -gn
+     &     *( cm2*(1.E+0 +cm3*gn)
+     &           *(1.E+0 +cm4*gn)
+     &       -( cm3*(1.E+0 +cm4*gn)
+     &         +cm4*(1.E+0 +cm3*gn) )
+     &       *(cm1+cm2*gn)            )
+     &     /( (1.E+0 +cm3*gn)
+     &       *(1.E+0 +cm4*gn) )**2
+        ENDIF
+c
+c abd
+c        if(ilev.le.57.and.ilev.ge.37) then
+c            print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
+c        endif
+c --->
+c       la decomposition de Taylor en q2 n'a de sens que
+c       dans les cas stratifies ou sn et sm sont quasi
+c       proportionnels a q2. ailleurs on laisse le meme
+c       algorithme car l'ajustement convectif fait le travail.
+c       mais c'est delirant quand sn et snq2 n'ont pas le meme
+c       signe : dans ces cas, on ne fait pas la decomposition.
+c<---
+c
+        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
+     &      snq2(igrid,ilev)=0.E+0
+        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
+     &      smq2(igrid,ilev)=0.E+0
+c
+C   Correction pour les couches stables.
+C   Schema repris de JHoltzlag Boville, lui meme venant de...
+
+        if (1.eq.1) then
+        snstable=1.-zlev(igrid,ilev)
+     s     /(700.*max(ustar(igrid),0.0001))
+        snstable=1.-zlev(igrid,ilev)/400.
+        snstable=max(snstable,0.)
+        snstable=snstable*snstable
+
+c abde       print*,'SN ',ilev,sn(1,ilev),snstable
+        if (sn(igrid,ilev).lt.snstable) then
+           sn(igrid,ilev)=snstable
+           snq2(igrid,ilev)=0.
+        endif
+
+        if (sm(igrid,ilev).lt.snstable) then
+           sm(igrid,ilev)=snstable
+           smq2(igrid,ilev)=0.
+        endif
+
+        endif
+
+c sn : coefficient de stabilite pour n
+c snq2 : premier terme du developement limite de sn en q2
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+c.......................................................................
+c  calcul de km et kn au debut du pas de temps
+c.......................................................................
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+      kmpre(igrid,1)=km(igrid,1)
+                                                      ENDDO
+c
+c-----------------------------------------------------------------------
+      DO ilev=2,nlev-1
+                                                      DO igrid=1,ngrid 
+c-----------------------------------------------------------------------
+c
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                                         *sm(igrid,ilev)
+        kmpre(igrid,ilev)=km(igrid,ilev)
+c
+c-----------------------------------------------------------------------
+                                                      ENDDO
+      ENDDO
+c-----------------------------------------------------------------------
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+      kmpre(igrid,nlev)=km(igrid,nlev)
+                                                      ENDDO
+c
+c.......................................................................
+c  boucle sur les niveaux 2 a nlev-1
+c.......................................................................
+c
+c---->
+      DO 10001 ilev=2,nlev-1
+c---->
+      DO 10002 igrid=1,ngrid 
+c
+c.......................................................................
+c
+c  calcul des termes sources et puits de l'equation de q2
+c  ------------------------------------------------------
+c
+        knq3=kn(igrid,ilev)*snq2(igrid,ilev)
+     &                                    /sn(igrid,ilev)
+        kmq3=km(igrid,ilev)*smq2(igrid,ilev)
+     &                                    /sm(igrid,ilev)
+c
+        termq=0.E+0
+        termq3=0.E+0
+        termqm2=0.E+0
+        termq3m2=0.E+0
+c
+        tmp1=dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+        tmp2=dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termqm2=termqm2
+     &    +dt*2.E+0 *km(igrid,ilev)*m2(igrid,ilev)
+     &    -dt*2.E+0 *kmq3*m2(igrid,ilev)
+        termq3m2=termq3m2
+     &    +dt*2.E+0 *kmq3*m2(igrid,ilev)
+c 
+        termq=termq
+     &    -dt*2.E+0 *kn(igrid,ilev)*n2(igrid,ilev)
+     &    +dt*2.E+0 *knq3*n2(igrid,ilev)
+        termq3=termq3
+     &    -dt*2.E+0 *knq3*n2(igrid,ilev)
+c
+        termq3=termq3
+     &    -dt*2.E+0 *q(igrid,ilev)**3 / (b1*long(igrid,ilev))
+c
+c.......................................................................
+c
+c  resolution stationnaire couplee avec le gradient de vitesse local
+c  -----------------------------------------------------------------
+c
+c  -----{on cherche le cisaillement qui annule l'equation de q^2
+c        supposee en q3}
+c
+        tmp1=termq+termq3
+        tmp2=termqm2+termq3m2
+        m2cstat=m2(igrid,ilev)
+     &      -(tmp1+tmp2)/(dt*2.E+0*km(igrid,ilev))
+        mcstat=sqrt(m2cstat)
+
+c  abde      print*,'M2 L=',ilev,mpre(igrid,ilev),mcstat
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (ilev.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)
+     &              *cd(igrid)
+     &              *( sqrt(u(igrid,3)**2+v(igrid,3)**2)
+     &                -mcstat/unsdzdec(igrid,ilev)
+     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
+     &                        *mpre(igrid,ilev+1)
+     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
+     &                          *mpre(igrid,ilev-1) )
+     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
+        ENDIF
+        tmp2=kmcstat
+     &      /( sm(igrid,ilev)/q2(igrid,ilev) )
+     &      /long(igrid,ilev)
+        qcstat=tmp2**(1.E+0/3.E+0)
+        q2cstat=qcstat**2
+c
+c.......................................................................
+c
+c  choix de la solution finale
+c  ---------------------------
+c
+          q(igrid,ilev)=qcstat
+          q2(igrid,ilev)=q2cstat
+          m(igrid,ilev)=mcstat
+c abd       if(ilev.le.57.and.ilev.ge.37) then
+c           print*,'L=',ilev,'   M2=',m2(igrid,ilev),m2cstat,
+c     s     'N2=',n2(igrid,ilev)
+c abd       endif
+          m2(igrid,ilev)=m2cstat
+c
+c --->
+c       pour des raisons simples q2 est minore 
+c<---
+c
+        IF (q2(igrid,ilev).lt.q2min) THEN
+          q2(igrid,ilev)=q2min
+          q(igrid,ilev)=sqrt(q2min)
+        ENDIF
+c
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sm(igrid,ilev)
+c abd
+c        if(ilev.le.57.and.ilev.ge.37) then
+c            print*,'L=',ilev,'   GN=',gn,'  SM=',sm(igrid,ilev)
+c        endif
+c
+c.......................................................................
+c
+10002 CONTINUE
+c
+10001 CONTINUE
+c
+c.......................................................................
+c
+c
+                                                      DO igrid=1,ngrid 
+      kn(igrid,1)=knmin
+      km(igrid,1)=kmmin
+c     kn(igrid,1)=cd(igrid)
+c     km(igrid,1)=cd(igrid)
+      q2(igrid,nlev)=q2(igrid,nlev-1)
+      q(igrid,nlev)=q(igrid,nlev-1)
+      kn(igrid,nlev)=kn(igrid,nlev-1)
+      km(igrid,nlev)=km(igrid,nlev-1)
+                                                      ENDDO
+c
+c  CALCUL DE LA DIFFUSION VERTICALE DE Q2
+      if (1.eq.1) then
+
+        do ilev=2,klev-1
+           sss=sss+plev(1,ilev-1)-plev(1,ilev+1)
+           sssq=sssq+(plev(1,ilev-1)-plev(1,ilev+1))*q2(1,ilev)
+        enddo
+c        print*,'Q2moy avant',sssq/sss
+c       print*,'Q2q20 ',(q2(1,ilev),ilev=1,10)
+c       print*,'Q2km0 ',(km(1,ilev),ilev=1,10)
+c   ! C'est quoi ca qu'etait dans l'original???
+c       do igrid=1,ngrid
+c          q2(igrid,1)=10.
+c       enddo
+c        q2s=q2
+c       do iii=1,10
+c       call vdif_q2(dt,g,rconst,plev,temp,km,q2)
+c       do ilev=1,klev+1
+c          write(iii+49,*) q2(1,ilev),zlev(1,ilev)
+c       enddo
+c       enddo
+c       stop
+c       do ilev=1,klev
+c          print*,zlev(1,ilev),q2s(1,ilev),q2(1,ilev)
+c       enddo
+c        q2s=q2-q2s
+c       do ilev=1,klev
+c          print*,q2s(1,ilev),zlev(1,ilev)
+c       enddo
+        do ilev=2,klev-1
+           sss=sss+plev(1,ilev-1)-plev(1,ilev+1)
+           sssq=sssq+(plev(1,ilev-1)-plev(1,ilev+1))*q2(1,ilev)
+        enddo
+        print*,'Q2moy apres',sssq/sss
+c
+c
+        do ilev=1,nlev
+           do igrid=1,ngrid
+              q2(igrid,ilev)=max(q2(igrid,ilev),q2min)
+              q(igrid,ilev)=sqrt(q2(igrid,ilev))
+
+c.......................................................................
+c
+c  calcul final de kn et km
+c  ------------------------
+c
+        gn=-long(igrid,ilev)**2 / q2(igrid,ilev)
+     &                                           * n2(igrid,ilev)
+        IF (gn.lt.gnmin) gn=gnmin
+        IF (gn.gt.gnmax) gn=gnmax
+        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn)
+        sm(igrid,ilev)=
+     &    (cm1+cm2*gn)
+     &   /( (1.E+0 +cm3*gn)*(1.E+0 +cm4*gn) )
+C   Correction pour les couches stables.
+C   Schema repris de JHoltzlag Boville, lui meme venant de...
+
+        if (1.eq.1) then
+        snstable=1.-zlev(igrid,ilev)
+     s     /(700.*max(ustar(igrid),0.0001))
+        snstable=1.-zlev(igrid,ilev)/400.
+        snstable=max(snstable,0.)
+        snstable=snstable*snstable
+
+c abde      print*,'SN ',ilev,sn(1,ilev),snstable
+        if (sn(igrid,ilev).lt.snstable) then
+           sn(igrid,ilev)=snstable
+           snq2(igrid,ilev)=0.
+        endif
+
+        if (sm(igrid,ilev).lt.snstable) then
+           sm(igrid,ilev)=snstable
+           smq2(igrid,ilev)=0.
+        endif
+
+        endif
+
+c sn : coefficient de stabilite pour n
+        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+     &                 *sn(igrid,ilev)
+        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
+c
+           enddo
+        enddo
+c       print*,'Q2km1 ',(km(1,ilev),ilev=1,10)
+
+      endif
+
+      RETURN
+      END
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histday.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/write_histday.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histday.h	(revision 633)
@@ -326,4 +326,5 @@
       CALL histwrite(nid_day,"tsic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
 c
+      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, is_ter)
       CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
       CALL histwrite(nid_day,"t2mter",itau_w,zx_tmp_2d,iim*jjmp1,
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histhf.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/write_histhf.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histhf.h	(revision 633)
@@ -98,4 +98,9 @@
       zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
       CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
+      CALL histwrite(nid_hf,"SWnetOR",itau_w,
+     $     zx_tmp_2d,iim*jjmp1,ndex2d)
+c
+      zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
+      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
       CALL histwrite(nid_hf,"SWdownOR",itau_w,
      $     zx_tmp_2d,iim*jjmp1,ndex2d)
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histmth.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/write_histmth.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histmth.h	(revision 633)
@@ -438,9 +438,10 @@
 c34EK
 c
+      ENDIF !iflag_con.GE.3
+c
       CALL gr_fi_ecrit(1, klon,iim,jjmp1, prw,zx_tmp_2d)
       CALL histwrite(nid_mth,"prw",itau_w,zx_tmp_2d,
      .               iim*jjmp1,ndex2d)
 c
-      ENDIF !iflag_con.GE.3
 c
 c
@@ -585,4 +586,6 @@
      .                                   iim*jjmp1*klev,ndex3d)
 c
+      IF (iflag_con.GE.3) THEN
+c
       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
       CALL histwrite(nid_mth,"Ma",itau_w,zx_tmp_3d,
@@ -601,4 +604,5 @@
      .                                   iim*jjmp1*klev,ndex3d)
 c
+      ENDIF !iflag_con.GE.3
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
@@ -762,14 +766,8 @@
 c
       IF (nqmax.GE.3) THEN
-      DO iq=1,nqmax-2
-      IF (iq.LE.99) THEN
-         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
-         WRITE(str2,'(i2.2)') iq
-         CALL histwrite(nid_mth,"trac"//str2,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-      ELSE
-         PRINT*, "Trop de traceurs"
-         CALL abort
-      ENDIF
+      DO iq=3,nqmax
+         CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq), zx_tmp_3d)
+         CALL histwrite(nid_mth,tnom(iq),itau_w,zx_tmp_3d,
+     .                                   iim*jjmp1*klev,ndex3d)
       ENDDO
       ENDIF
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histrac.h
===================================================================
--- LMDZ4/branches/unlabeled-1.1.1/libf/phylmd/write_histrac.h	(revision 547)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/write_histrac.h	(revision 633)
@@ -52,5 +52,14 @@
      .                                   iim*(jjm+1)*klev,ndex3d)
 
-#ifdef INCA_CH4
+! Ajout Anne
+!#ifdef INCA_AER
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,airm, zx_tmp_3d)
+      CALL histwrite(nid_tra,"airm",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+!#endif
+
+! Fin ajout Anne
+
+#ifdef INCA
 #ifdef INCAINFO
       DO it=1, phtcnt
@@ -130,9 +139,9 @@
        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,scavcoef_st(1,1,it),
      .                  zx_tmp_3d)
-       CALL histwrite(nid_tra,"scavcoef_st",itau_w,zx_tmp_3d,
+       CALL histwrite(nid_tra2,"scavcoef_st",itau_w,zx_tmp_3d,
      .                  iim*(jjm+1)*klev,ndex3d)
        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,scavcoef_cv(1,1,it),
      .                  zx_tmp_3d)
-       CALL histwrite(nid_tra,"scavcoef_cv",itau_w,zx_tmp_3d,
+       CALL histwrite(nid_tra2,"scavcoef_cv",itau_w,zx_tmp_3d,
      .                  iim*(jjm+1)*klev,ndex3d)
 
@@ -215,5 +224,5 @@
 #endif
        else
-#ifdef INCA_CH4
+#ifdef INCA
        if ( solsym(it) == 'OX' ) then
        zx_tmp_3d = zx_tmp_3d * dry_mass / nadv_mass(id_o3)
@@ -234,22 +243,35 @@
      .                                   iim*(jjm+1)*klev,ndex3d)
       endif
+      
+c----Olivia
+       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_th(1,1,it),zx_tmp_3d)
+       CALL histwrite(nid_tra,"d_tr_th_"//tnom(it+2),itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_cv(1,1,it),zx_tmp_3d)
+       CALL histwrite(nid_tra,"d_tr_cv_"//tnom(it+2),itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+       CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_cl(1,1,it),zx_tmp_3d)
+       CALL histwrite(nid_tra,"d_tr_cl_"//tnom(it+2),itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+c---fin Olivia      
+      
 #endif
       ENDDO
 
 #ifdef INCA
-#ifdef INCA_CH4
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_tr_col(1), zx_tmp_2d)
+!#ifdef INCA_CH4
+      CALL gr_fi_ecrit(1, klon,iim,jjm+1, o3_col(1), zx_tmp_2d)
       CALL histwrite(nid_tra,"O3_column",itau_w,zx_tmp_2d,
      .     iim*(jjm+1),ndex2d)
 
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, co_tr_col(1), zx_tmp_2d)
+      CALL gr_fi_ecrit(1, klon,iim,jjm+1, co_col(1), zx_tmp_2d)
       CALL histwrite(nid_tra,"CO_column",itau_w,zx_tmp_2d,
      .     iim*(jjm+1),ndex2d)
 
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ch4_tr_col(1), zx_tmp_2d)
+      CALL gr_fi_ecrit(1, klon,iim,jjm+1, ch4_col(1), zx_tmp_2d)
       CALL histwrite(nid_tra,"CH4_column",itau_w,zx_tmp_2d,
      .     iim*(jjm+1),ndex2d)
 
-      CALL gr_fi_ecrit(1, klon,iim,jjm+1, no2_tr_col(1), zx_tmp_2d)
+      CALL gr_fi_ecrit(1, klon,iim,jjm+1, no2_col(1), zx_tmp_2d)
       CALL histwrite(nid_tra,"NO2_column",itau_w,zx_tmp_2d,
      .     iim*(jjm+1),ndex2d)
@@ -268,4 +290,112 @@
       CALL histwrite(nid_tra,"O3_loss",itau_w,zx_tmp_3d,
      .                                   iim*(jjm+1)*klev,ndex3d)
+! Ajout Anne
+#ifdef INCA_AER
+! for sulfur cycle
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,SO2_p_dmsoh(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"SO2_p_dmsoh",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,SO2_p_dmsno3(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"SO2_p_dmsno3",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,SO2_p_h2soh(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"SO2_p_h2soh",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,SO2_p_dmsooh(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"SO2_p_dmsooh",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,DMSO_p_dmsoh(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"DMSO_p_dmsoh",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,ASMSAM_p_dmsooh(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"ASMSAM_p_dmsooh",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,ASSO4M_p_so2oh(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"ASSO4M_p_so2oh",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,ASSO4M_p_so2h2o2(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"ASSO4M_p_so2h2o2",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,ASSO4M_p_so2o3(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"ASSO4M_p_so2o3",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+c closing the sulfur budget
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wet3d_so2(1,1), zx_tmp_3d)
+      CALL histwrite(nid_tra,"Wet3D_SO2",itau_w,zx_tmp_3d,
+     .     iim*(jjm+1)*klev,ndex)
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wet3d_dms(1,1), zx_tmp_3d)
+      CALL histwrite(nid_tra,"Wet3D_DMS",itau_w,zx_tmp_3d,
+     .     iim*(jjm+1)*klev,ndex)
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wet3d_hno3(1,1), zx_tmp_3d)
+      CALL histwrite(nid_tra,"Wet3D_HNO3",itau_w,zx_tmp_3d,
+     .     iim*(jjm+1)*klev,ndex)
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wet3d_h2o2(1,1), zx_tmp_3d)
+      CALL histwrite(nid_tra,"Wet3D_H2O2",itau_w,zx_tmp_3d,
+     .     iim*(jjm+1)*klev,ndex)
+
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,PH_HIST(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"PH_HIST",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+#endif
+
+#ifdef INCA_NMHC
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,CO2_basprod(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"CO2_basprod",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,CO2_nmhcprod(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"CO2_nmhcprod",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,CO2_radicalprod(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"CO2_radicalprod",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,hno3_prod(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"HNO3_prod",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,hno3_loss(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"HNO3_loss",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,co_prod(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"CO_prod",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1,co_loss(1,1),
+     .     zx_tmp_3d)
+      CALL histwrite(nid_tra,"CO_loss",itau_w,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex)
+
+#endif
+
+! Fin ajout Anne
 
 !     ... Special section for daytime averaging
@@ -279,5 +409,5 @@
 !    .                                  iim*(jjm+1)*klev,ndex3d)
 
-#endif
+!#endif
 #else
 
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/yamada.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/yamada.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/yamada.F	(revision 633)
@@ -0,0 +1,169 @@
+!
+! $Header$
+!
+      SUBROUTINE yamada(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,km,kn,ustar
+     s   ,l_mix)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon),snstable
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1)
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      integer l_mix,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      logical first
+      save first
+      data first/.true./
+
+
+      integer ig,k
+
+      real ri,zrif,zalpha,zsm
+      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      real l(klon,klev+1),l0(klon)
+
+      real sq(klon),sqz(klon),zz(klon,klev+1)
+      integer iter
+
+      real ric,rifc,b1,kap
+      save ric,rifc,b1,kap
+      data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/
+
+      real frif,falpha,fsm
+
+      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
+      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
+      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+
+      if (0.eq.1.and.first) then
+      do ig=1,1000
+         ri=(ig-800.)/500.
+         if (ri.lt.ric) then
+            zrif=frif(ri)
+         else
+            zrif=rifc
+         endif
+         if(zrif.lt.0.16) then
+            zalpha=falpha(zrif)
+            zsm=fsm(zrif)
+         else
+            zalpha=1.12
+            zsm=0.085
+         endif
+         print*,ri,rif,zalpha,zsm
+      enddo
+      first=.false.
+      endif
+
+c  Correction d'un bug sauvage a verifier.
+c      do k=2,nlev
+      do k=2,nlay
+                                                          do ig=1,ngrid
+         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
+         m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
+     s             /(dz(ig,k)*dz(ig,k))
+         n2(ig,k)=g*2.*(teta(ig,k)-teta(ig,k-1))
+     s            /(teta(ig,k-1)+teta(ig,k))  /dz(ig,k)
+         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
+         if (ri.lt.ric) then
+            rif(ig,k)=frif(ri)
+         else
+            rif(ig,k)=rifc
+         endif
+         if(rif(ig,k).lt.0.16) then
+            alpha(ig,k)=falpha(rif(ig,k))
+            sm(ig,k)=fsm(rif(ig,k))
+         else
+            alpha(ig,k)=1.12
+            sm(ig,k)=0.085
+         endif
+         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
+                                                          enddo
+      enddo
+
+c iterration pour determiner la longueur de melange
+
+                                                          do ig=1,ngrid
+      l0(ig)=100.
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+                                                          enddo
+      enddo
+
+      do iter=1,10
+                                                          do ig=1,ngrid
+         sq(ig)=1.e-10
+         sqz(ig)=1.e-10
+                                                          enddo
+         do k=2,klev-1
+                                                          do ig=1,ngrid
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+           l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
+           zq=sqrt(q2(ig,k))
+           sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+           sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+         enddo
+                                                          do ig=1,ngrid
+         l0(ig)=0.2*sqz(ig)/sq(ig)
+                                                          enddo
+c(abd 3 5 2)         print*,'ITER=',iter,'  L0=',l0
+
+      enddo
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10)))
+         q2(ig,k)=l(ig,k)**2*zz(ig,k)
+         km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         kn(ig,k)=km(ig,k)*alpha(ig,k)
+                                                          enddo
+      enddo
+
+      return
+      end
Index: LMDZ4/branches/LMDZ4_par_0/libf/phylmd/yamada4.F
===================================================================
--- LMDZ4/branches/LMDZ4_par_0/libf/phylmd/yamada4.F	(revision 633)
+++ LMDZ4/branches/LMDZ4_par_0/libf/phylmd/yamada4.F	(revision 633)
@@ -0,0 +1,462 @@
+!
+! $Header$
+!
+      SUBROUTINE yamada4(ngrid,dt,g,rconst,plev,temp
+     s   ,zlev,zlay,u,v,teta,cd,q2,km,kn,kq,ustar
+     s   ,iflag_pbl)
+      IMPLICIT NONE
+c.......................................................................
+#include "dimensions.h"
+#include "dimphy.h"
+c.......................................................................
+c
+c dt : pas de temps
+c g  : g
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c zlay : altitude au centre de chaque couche
+c u,v : vitesse au centre de chaque couche
+c       (en entree : la valeur au debut du pas de temps)
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c cd : cdrag
+c      (en entree : la valeur au debut du pas de temps)
+c q2 : $q^2$ au bas de chaque couche
+c      (en entree : la valeur au debut du pas de temps)
+c      (en sortie : la valeur a la fin du pas de temps)
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c  iflag_pbl doit valoir entre 6 et 9
+c      l=6, on prend  systematiquement une longueur d'equilibre
+c    iflag_pbl=6 : MY 2.0
+c    iflag_pbl=7 : MY 2.0.Fournier
+c    iflag_pbl=8 : MY 2.5
+c    iflag_pbl=9 : un test ?
+
+c.......................................................................
+      REAL dt,g,rconst
+      real plev(klon,klev+1),temp(klon,klev)
+      real ustar(klon)
+      real kmin,qmin,pblhmin(klon),coriol(klon)
+      REAL zlev(klon,klev+1)
+      REAL zlay(klon,klev)
+      REAL u(klon,klev)
+      REAL v(klon,klev)
+      REAL teta(klon,klev)
+      REAL cd(klon)
+      REAL q2(klon,klev+1),qpre
+      REAL unsdz(klon,klev)
+      REAL unsdzdec(klon,klev+1)
+
+      REAL km(klon,klev+1)
+      REAL kmpre(klon,klev+1),tmp2
+      REAL mpre(klon,klev+1)
+      REAL kn(klon,klev+1)
+      REAL kq(klon,klev+1)
+      real ff(klon,klev+1),delta(klon,klev+1)
+      real aa(klon,klev+1),aa0,aa1
+      integer iflag_pbl,ngrid
+
+
+      integer nlay,nlev
+      PARAMETER (nlay=klev)
+      PARAMETER (nlev=klev+1)
+
+      logical first
+      integer ipas
+      save first,ipas
+      data first,ipas/.true.,0/
+
+
+      integer ig,k
+
+
+      real ri,zrif,zalpha,zsm,zsn
+      real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev)
+
+      real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1)
+      real dtetadz(klon,klev+1)
+      real m2cstat,mcstat,kmcstat
+      real l(klon,klev+1),l0(klon)
+      save l0
+
+      real sq(klon),sqz(klon),zz(klon,klev+1)
+      integer iter
+
+      real ric,rifc,b1,kap
+      save ric,rifc,b1,kap
+      data ric,rifc,b1,kap/0.195,0.191,16.6,0.4/
+
+      real frif,falpha,fsm
+      real fl,zzz,zl0,zq2,zn2
+
+      real rino(klon,klev+1),smyam(klon,klev),styam(klon,klev)
+     s  ,lyam(klon,klev),knyam(klon,klev)
+     s  ,w2yam(klon,klev),t2yam(klon,klev)
+      common/pbldiag/rino,smyam,styam,lyam,knyam,w2yam,t2yam
+
+      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
+      falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri)
+      fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri))
+      fl(zzz,zl0,zq2,zn2)=
+     s     max(min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+     s     ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) ,1.)
+
+      if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.9)) then
+           stop'probleme de coherence dans appel a MY'
+      endif
+
+      ipas=ipas+1
+      if (0.eq.1.and.first) then
+      do ig=1,1000
+         ri=(ig-800.)/500.
+         if (ri.lt.ric) then
+            zrif=frif(ri)
+         else
+            zrif=rifc
+         endif
+         if(zrif.lt.0.16) then
+            zalpha=falpha(zrif)
+            zsm=fsm(zrif)
+         else
+            zalpha=1.12
+            zsm=0.085
+         endif
+c     print*,ri,rif,zalpha,zsm
+      enddo
+      endif
+
+c.......................................................................
+c  les increments verticaux
+c.......................................................................
+c
+c!!!!! allerte !!!!!c
+c!!!!! zlev n'est pas declare a nlev !!!!!c
+c!!!!! ---->
+                                                      DO ig=1,ngrid
+            zlev(ig,nlev)=zlay(ig,nlay)
+     &             +( zlay(ig,nlay) - zlev(ig,nlev-1) )
+                                                      ENDDO
+c!!!!! <----
+c!!!!! allerte !!!!!c
+c
+      DO k=1,nlay
+                                                      DO ig=1,ngrid
+        unsdz(ig,k)=1.E+0/(zlev(ig,k+1)-zlev(ig,k))
+                                                      ENDDO
+      ENDDO
+                                                      DO ig=1,ngrid
+      unsdzdec(ig,1)=1.E+0/(zlay(ig,1)-zlev(ig,1))
+                                                      ENDDO
+      DO k=2,nlay
+                                                      DO ig=1,ngrid
+        unsdzdec(ig,k)=1.E+0/(zlay(ig,k)-zlay(ig,k-1))
+                                                     ENDDO
+      ENDDO
+                                                      DO ig=1,ngrid
+      unsdzdec(ig,nlay+1)=1.E+0/(zlev(ig,nlay+1)-zlay(ig,nlay))
+                                                     ENDDO
+c
+c.......................................................................
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         dz(ig,k)=zlay(ig,k)-zlay(ig,k-1)
+         m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2)
+     s             /(dz(ig,k)*dz(ig,k))
+         dtetadz(ig,k)=(teta(ig,k)-teta(ig,k-1))/dz(ig,k)
+         n2(ig,k)=g*2.*dtetadz(ig,k)/(teta(ig,k-1)+teta(ig,k))
+c        n2(ig,k)=0.
+         ri=n2(ig,k)/max(m2(ig,k),1.e-10)
+         if (ri.lt.ric) then
+            rif(ig,k)=frif(ri)
+         else
+            rif(ig,k)=rifc
+         endif
+         if(rif(ig,k).lt.0.16) then
+            alpha(ig,k)=falpha(rif(ig,k))
+            sm(ig,k)=fsm(rif(ig,k))
+         else
+            alpha(ig,k)=1.12
+            sm(ig,k)=0.085
+         endif
+         zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k)
+c     print*,'RIF L=',k,rif(ig,k),ri*alpha(ig,k)
+
+
+                                                          enddo
+      enddo
+
+
+c====================================================================
+c   Au premier appel, on determine l et q2 de facon iterative.
+c iterration pour determiner la longueur de melange
+
+
+      if (first.or.iflag_pbl.eq.6) then
+                                                          do ig=1,ngrid
+      l0(ig)=10.
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig))
+                                                          enddo
+      enddo
+
+      do iter=1,10
+                                                          do ig=1,ngrid
+         sq(ig)=1.e-10
+         sqz(ig)=1.e-10
+                                                          enddo
+         do k=2,klev-1
+                                                          do ig=1,ngrid
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+           l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
+           zq=sqrt(q2(ig,k))
+           sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+           sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+         enddo
+                                                          do ig=1,ngrid
+         l0(ig)=0.2*sqz(ig)/sq(ig)
+c        l0(ig)=30.
+                                                          enddo
+c      print*,'ITER=',iter,'  L0=',l0
+
+      enddo
+
+c     print*,'Fin de l initialisation de q2 et l0'
+
+      endif ! first
+
+c====================================================================
+c  Calcul de la longueur de melange.
+c====================================================================
+
+c   Mise a jour de l0
+                                                          do ig=1,ngrid
+      sq(ig)=1.e-10
+      sqz(ig)=1.e-10
+                                                          enddo
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        zq=sqrt(q2(ig,k))
+        sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1))
+        sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1))
+                                                          enddo
+      enddo
+                                                          do ig=1,ngrid
+      l0(ig)=0.2*sqz(ig)/sq(ig)
+c        l0(ig)=30.
+                                                          enddo
+c      print*,'ITER=',iter,'  L0=',l0
+c   calcul de l(z)
+      do k=2,klev
+                                                          do ig=1,ngrid
+         l(ig,k)=fl(zlev(ig,k),l0(ig),q2(ig,k),n2(ig,k))
+         if(first) then
+           q2(ig,k)=l(ig,k)**2*zz(ig,k)
+         endif
+                                                          enddo
+      enddo
+
+c====================================================================
+c   Yamada 2.0
+c====================================================================
+      if (iflag_pbl.eq.6) then
+
+      do k=2,klev
+                                                          do ig=1,ngrid
+         q2(ig,k)=l(ig,k)**2*zz(ig,k)
+                                                          enddo
+      enddo
+
+
+      else if (iflag_pbl.eq.7) then
+c====================================================================
+c   Yamada 2.Fournier
+c====================================================================
+
+c  Calcul de l,  km, au pas precedent
+      do k=2,klev
+                                                          do ig=1,ngrid
+c        print*,'SMML=',sm(ig,k),l(ig,k)
+         delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
+         kmpre(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         mpre(ig,k)=sqrt(m2(ig,k))
+c        print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
+                                                          enddo
+      enddo
+
+      do k=2,klev-1
+                                                          do ig=1,ngrid
+        m2cstat=max(alpha(ig,k)*n2(ig,k)+delta(ig,k)/b1,1.e-12)
+        mcstat=sqrt(m2cstat)
+
+c        print*,'M2 L=',k,mpre(ig,k),mcstat
+c
+c  -----{puis on ecrit la valeur de q qui annule l'equation de m
+c        supposee en q3}
+c
+        IF (k.eq.2) THEN
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(ig,k)*kmpre(ig,k+1)
+     &                        *mpre(ig,k+1)
+     &      +unsdz(ig,k-1)
+     &              *cd(ig)
+     &              *( sqrt(u(ig,3)**2+v(ig,3)**2)
+     &                -mcstat/unsdzdec(ig,k)
+     &                -mpre(ig,k+1)/unsdzdec(ig,k+1) )**2)
+     &      /( unsdz(ig,k)+unsdz(ig,k-1) )
+        ELSE
+          kmcstat=1.E+0 / mcstat
+     &    *( unsdz(ig,k)*kmpre(ig,k+1)
+     &                        *mpre(ig,k+1)
+     &      +unsdz(ig,k-1)*kmpre(ig,k-1)
+     &                          *mpre(ig,k-1) )
+     &      /( unsdz(ig,k)+unsdz(ig,k-1) )
+        ENDIF
+c       print*,'T2 L=',k,tmp2
+        tmp2=kmcstat
+     &      /( sm(ig,k)/q2(ig,k) )
+     &      /l(ig,k)
+        q2(ig,k)=max(tmp2,1.e-12)**(2./3.)
+c       print*,'Q2 L=',k,q2(ig,k)
+c
+                                                          enddo
+      enddo
+
+      else if (iflag_pbl.ge.8) then
+c====================================================================
+c   Yamada 2.5 a la Didi
+c====================================================================
+
+
+c  Calcul de l,  km, au pas precedent
+      do k=2,klev
+                                                          do ig=1,ngrid
+c        print*,'SMML=',sm(ig,k),l(ig,k)
+         delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
+         if (delta(ig,k).lt.1.e-20) then
+c     print*,'ATTENTION   L=',k,'   Delta=',delta(ig,k)
+            delta(ig,k)=1.e-20
+         endif
+         km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
+         aa0=
+     s   (m2(ig,k)-alpha(ig,k)*n2(ig,k)-delta(ig,k)/b1)
+         aa1=
+     s   (m2(ig,k)*(1.-rif(ig,k))-delta(ig,k)/b1)
+c abder      print*,'AA L=',k,aa0,aa1,aa1/max(m2(ig,k),1.e-20)
+         aa(ig,k)=aa1*dt/(delta(ig,k)*l(ig,k))
+c     print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
+         qpre=sqrt(q2(ig,k))
+         if (iflag_pbl.eq.8 ) then
+            if (aa(ig,k).gt.0.) then
+               q2(ig,k)=(qpre+aa(ig,k)*qpre*qpre)**2
+            else
+               q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
+            endif
+         else ! iflag_pbl=9
+            if (aa(ig,k)*qpre.gt.0.9) then
+               q2(ig,k)=(qpre*10.)**2
+            else
+               q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
+            endif
+         endif
+         q2(ig,k)=min(max(q2(ig,k),1.e-10),1.e4)
+c     print*,'Q2 L=',k,q2(ig,k),qpre*qpre
+                                                          enddo
+      enddo
+
+      endif ! Fin du cas 8
+
+c     print*,'OK8'
+
+c====================================================================
+c   Calcul des coefficients de mélange
+c====================================================================
+      do k=2,klev
+c     print*,'k=',k
+                                                          do ig=1,ngrid
+cabde      print*,'KML=',l(ig,k),q2(ig,k),sm(ig,k)
+         zq=sqrt(q2(ig,k))
+         km(ig,k)=l(ig,k)*zq*sm(ig,k)
+         kn(ig,k)=km(ig,k)*alpha(ig,k)
+         kq(ig,k)=l(ig,k)*zq*0.2
+c     print*,'KML=',km(ig,k),kn(ig,k)
+                                                          enddo
+      enddo
+
+c     if (iflag_pbl.ge.7..and.0.eq.1) then
+c        q2(:,1)=q2(:,2)
+c        call vdif_q2(dt,g,rconst,plev,temp,kq,q2)
+c     endif
+
+c   Traitement des cas noctrunes avec l'introduction d'une longueur
+c   minilale.
+
+c====================================================================
+c   Traitement particulier pour les cas tres stables.
+c   D'apres Holtslag Boville.
+
+      print*,'YAMADA4 0'
+
+                                                          do ig=1,ngrid
+      coriol(ig)=1.e-4
+      pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
+                                                          enddo
+
+       print*,'pblhmin ',pblhmin
+CTest a remettre 21 11 02
+c test abd 13 05 02      if(0.eq.1) then
+      if(1.eq.1) then
+      do k=2,klev
+         do ig=1,klon
+            if (teta(ig,2).gt.teta(ig,1)) then
+               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
+               kmin=kap*zlev(ig,k)*qmin
+            else
+               kmin=-1. ! kmin n'est utilise que pour les SL stables.
+            endif 
+            if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then
+c               print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k)
+c     s           ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k)
+               kn(ig,k)=kmin
+               km(ig,k)=kmin
+               kq(ig,k)=kmin
+c   la longueur de melange est suposee etre l= kap z
+c   K=l q Sm d'ou q2=(K/l Sm)**2
+               q2(ig,k)=(qmin/sm(ig,k))**2
+            endif
+         enddo
+      enddo
+      endif
+
+      print*,'YAMADA4 1'
+c   Diagnostique pour stokage
+
+      rino=rif
+      smyam(:,1:klev)=sm(:,1:klev)
+      styam=sm(:,1:klev)*alpha(:,1:klev)
+      lyam(1:klon,1:klev)=l(:,1:klev)
+      knyam(1:klon,1:klev)=kn(:,1:klev)
+
+c   Estimations de w'2 et T'2 d'apres Abdela et McFarlane
+
+        if(1.eq.0)then
+      w2yam=q2(:,1:klev)*0.24
+     s    +lyam(:,1:klev)*5.17*kn(:,1:klev)*n2(:,1:klev)
+     s   /sqrt(q2(:,1:klev))
+
+      t2yam=9.1*kn(:,1:klev)*dtetadz(:,1:klev)**2/sqrt(q2(:,1:klev))
+     s  *lyam(:,1:klev)
+	endif
+
+c     print*,'OKFIN'
+      first=.false.
+      return
+      end
