Index: LMDZ.3.3/branches/rel-LF/create_make_gcm
===================================================================
--- LMDZ.3.3/branches/LF/create_make_gcm	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/create_make_gcm	(revision 79)
@@ -146,4 +146,5 @@
          for stri in ` ( sed -n "/\#include/s/\#include//p" $fili.F | sed 's/\"//g' ; egrep -i '^ *use ' $fili.F | awk ' { print $2 } ' ) `
          do
+            stri=`echo $stri | tr [A-Z] [a-z]`
             if [ -f $stri ] ; then
                echo $str1 \\
Index: LMDZ.3.3/branches/rel-LF/libf/bibio/formcoord.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/bibio/formcoord.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/bibio/formcoord.F	(revision 79)
@@ -0,0 +1,51 @@
+      subroutine formcoord(unit,n,x,a,rev,text)
+      implicit none
+      integer n,unit,ndec
+      logical rev
+      real x(n),a
+      character*4 text
+
+      integer i,id,i1,i2,in
+      real dx,dxmin
+
+      if(rev) then
+         id=-1
+         i1=n
+         i2=n-1
+         in=1
+         write(unit,3000) text(1:1)
+      else
+         id=1
+         i1=1
+         i2=2
+         in=n
+      endif
+
+      if (n.lt.2) then
+         ndec=1
+         write(unit,1000) text,n,x(1)*a
+      else
+         dxmin=abs(x(2)-x(1))
+         do i=2,n-1
+            dx=abs(x(i+1)-x(i))
+            if (dx.lt.dxmin) dxmin=dx
+         enddo
+
+         ndec=-log10(dxmin)+2
+         if(mod(n,6).eq.1) then
+            write(unit,1000) text,n,x(i1)*a
+            write(unit,2000) (x(i)*a,i=i2,in,id)
+         else
+            write(unit,1000) text,n
+            write(unit,2000) (x(i)*a,i=i1,in,id)
+         endif
+      endif
+
+1000  format(a4,2x,i4,' LEVELS',43x,f12.2)
+2000  format(6f12.2)
+c1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
+c2000  format(6f12.<ndec>)
+3000  format('FORMAT ',a1,'REV')
+      return
+
+      end
Index: LMDZ.3.3/branches/rel-LF/libf/bibio/initfluxsto.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/bibio/initfluxsto.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/bibio/initfluxsto.F	(revision 79)
@@ -0,0 +1,223 @@
+      subroutine initfluxsto
+     .  (infile,tstep,t_ops,t_wrt,nq,
+     .                    fileid,filevid,filedid)
+
+       USE IOIPSL
+
+      implicit none
+
+C
+C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+C   au format IOIPSL
+C
+C   Appels succesifs des routines: histbeg
+C                                  histhori
+C                                  histver
+C                                  histdef
+C                                  histend
+C
+C   Entree:
+C
+C      infile: nom du fichier histoire a creer
+C      day0,anne0: date de reference
+C      tstep: duree du pas de temps en seconde
+C      t_ops: frequence de l'operation pour IOIPSL
+C      t_wrt: frequence d'ecriture sur le fichier
+C      nq: nombre de traceurs
+C
+C   Sortie:
+C      fileid: ID du fichier netcdf cree
+C      filevid:ID du fichier netcdf pour la grille v
+C
+C   L. Fairhead, LMD, 03/99
+C
+C =====================================================================
+C
+C   Declarations
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+
+C   Arguments
+C
+      character*(*) infile
+      integer*4 itau
+      real tstep, t_ops, t_wrt
+      integer fileid, filevid,filedid
+      integer nq,ndex(1)
+      real nivd(1)
+
+C   Variables locales
+C
+      integer tau0
+      real zjulian
+      character*3 str
+      character*10 ctrac
+      integer iq
+      real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
+      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
+      integer ii,jj
+      integer zan
+      logical ok_sync
+C
+C  Initialisations
+C
+      pi = 4. * atan (1.)
+      str='q  '
+      ctrac = 'traceur   '
+      ok_sync = .true.
+C
+C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+C         
+
+      zan = anne_ini
+      CALL ymds2ju(zan, 1, 1, 0.0, zjulian)
+      zjulian = zjulian + day_ini
+      tau0 = 0
+	
+	do jj = 1, jjp1
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonu(ii) * 180. / pi
+          rlat(ii,jj) = rlatu(jj) * 180. / pi
+        enddo
+      enddo
+ 
+      call histbeg(infile, iip1, rlong, jjp1, rlat,
+     .             1, iip1, 1, jjp1,
+     .             tau0, zjulian, tstep, uhoriid, fileid)
+C
+C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
+C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans 
+C  un meme fichier)
+
+
+      do jj = 1, jjm
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonv(ii) * 180. / pi
+          rlat(ii,jj) = rlatv(jj) * 180. / pi
+        enddo
+      enddo
+
+      call histbeg('fluxstokev.nc', iip1, rlong, jjm, rlat,
+     .             1, iip1, 1, jjm,
+     .             tau0, zjulian, tstep, vhoriid, filevid)
+	
+	rl(1,1) = 1.	
+      call histbeg('defstoke.nc', 1, rl, 1, rl,
+     .             1, 1, 1, 1,
+     .             tau0, zjulian, tstep, dhoriid, filedid)
+
+C
+C  Appel a histhori pour rajouter les autres grilles horizontales
+C
+      do jj = 1, jjp1
+        do ii = 1, iip1
+          rlong(ii,jj) = rlonv(ii) * 180. / pi
+          rlat(ii,jj) = rlatu(jj) * 180. / pi
+        enddo
+      enddo
+
+      call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
+     .              'Grille points scalaires', thoriid)
+	
+C
+C  Appel a histvert pour la grille verticale
+C
+      call histvert(fileid, 'sig_s', 'Niveaux sigma',
+     . 'sigma_level',
+     .              llm, nivsigs, zvertiid)
+C Pour le fichier V
+      call histvert(filevid, 'sig_s', 'Niveaux sigma',
+     .  'sigma_level',
+     .              llm, nivsigs, zvertiid)
+c pour le fichier def
+      nivd(1) = 1
+      call histvert(filedid, 'sig_s', 'Niveaux sigma',
+     .  'sigma_level',
+     .              1, nivd, dvertiid)
+
+C
+C  Appels a histdef pour la definition des variables a sauvegarder
+	
+	CALL histdef(fileid, "phis", "Surface geop. height", "-",
+     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+
+         CALL histdef(fileid, "aire", "Grid area", "-",
+     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+	
+	CALL histdef(filedid, "dtvr", "tps dyn", "s",
+     .                1,1,dhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+        
+         CALL histdef(filedid, "istdyn", "tps stock", "s",
+     .                1,1,dhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+         
+         CALL histdef(filedid, "istphy", "tps stock phy", "s",
+     .                1,1,dhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+
+
+C
+C Masse 
+C
+      call histdef(fileid, 'masse', 'Masse', 'kg',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Pbaru 
+C
+      call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
+     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C  Pbarv 
+C
+      call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
+     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  w 
+C
+      call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C  Temperature potentielle
+C
+      call histdef(fileid, 'teta', 'temperature potentielle', '-',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+
+C
+C Geopotentiel 
+C
+      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
+     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+C  Fin
+C
+      call histend(fileid)
+      call histend(filevid)
+      call histend(filedid)
+      if (ok_sync) then
+        call histsync(fileid)
+        call histsync(filevid)
+        call histsync(filedid)
+      endif
+	
+      return
+      end
Index: LMDZ.3.3/branches/rel-LF/libf/bibio/writedynav.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/bibio/writedynav.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/bibio/writedynav.F	(revision 79)
@@ -58,5 +58,5 @@
 C   Variables locales
 C
-      integer ndex(1),iq, ii, ll
+      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
       character*3 str
       real us(ip1jmp1*llm), vs(ip1jmp1*llm)
@@ -68,5 +68,6 @@
 C
       str='q  '
-      ndex(1) = 0
+      ndex3d = 0
+      ndex2d = 0
       ok_sync = .TRUE.
 
@@ -81,5 +82,5 @@
       call gr_u_scal(llm, unat, us)
       call histwrite(histid, 'u', time, us, 
-     .               iip1*jjp1*llm, ndex)
+     .               iip1*jjp1*llm, ndex3d)
 C
 C  Vents V scalaire
@@ -87,5 +88,5 @@
       call gr_v_scal(llm, vnat, vs)
       call histwrite(histid, 'v', time, vs, 
-     .               iip1*jjp1*llm, ndex)
+     .               iip1*jjp1*llm, ndex3d)
 C
 C  Temperature moyennee
@@ -95,10 +96,10 @@
       enddo
       call histwrite(histid, 'temp', time, tm, 
-     .                iip1*jjp1*llm, ndex)
+     .                iip1*jjp1*llm, ndex3d)
 C
 C  Geopotentiel
 C
       call histwrite(histid, 'phi', time, phi, 
-     .                iip1*jjp1*llm, ndex)
+     .                iip1*jjp1*llm, ndex3d)
 C
 C  Traceurs
@@ -112,5 +113,5 @@
           ENDIF
           call histwrite(histid, str, time, q(:,:,iq), 
-     .                   iip1*jjp1*llm, ndex)
+     .                   iip1*jjp1*llm, ndex3d)
         enddo
       endif
@@ -118,17 +119,17 @@
 C  Masse
 C
-       call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex)
+       call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex2d)
 C
 C  Pression au sol
 C
-       call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex)
+       call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex2d)
 C
 C  Geopotentiel au sol
 C
-       call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex)
+       call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex2d)
 C
 C  Fin
 C
-      if (ok_sync) call histsync
+      if (ok_sync) call histsync(histid)
       return
       end
Index: LMDZ.3.3/branches/rel-LF/libf/bibio/writehist.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/bibio/writehist.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/bibio/writehist.F	(revision 79)
@@ -59,5 +59,6 @@
 C   Variables locales
 C
-      integer ndex(1),iq, ii, ll
+      integer iq, ii, ll
+      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
       character*3 str
       logical ok_sync
@@ -66,5 +67,7 @@
 C
       str='q  '
-      ndex(1) = 0
+      ndexu = 0
+      ndexv = 0
+      ndex2d = 0
       ok_sync =.TRUE.
 C
@@ -74,5 +77,5 @@
 C
       call histwrite(histid, 'ucov', time, ucov, 
-     .               iip1*jjp1*llm, ndex)
+     .               iip1*jjp1*llm, ndexu)
 
 C
@@ -80,5 +83,5 @@
 C
       call histwrite(histvid, 'vcov', time, vcov, 
-     .               iip1*jjm*llm, ndex)
+     .               iip1*jjm*llm, ndexv)
 
 C
@@ -86,10 +89,10 @@
 C
       call histwrite(histid, 'teta', time, teta, 
-     .                iip1*jjp1*llm, ndex)
+     .                iip1*jjp1*llm, ndexu)
 C
 C  Geopotentiel
 C
       call histwrite(histid, 'phi', time, phi, 
-     .                iip1*jjp1*llm, ndex)
+     .                iip1*jjp1*llm, ndexu)
 C
 C  Traceurs
@@ -103,5 +106,5 @@
           ENDIF
           call histwrite(histid, str, time, q(:,:,iq), 
-     .                   iip1*jjp1*llm, ndex)
+     .                   iip1*jjp1*llm, ndexu)
         enddo
       endif
@@ -109,17 +112,20 @@
 C  Masse
 C
-      call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex)
+      call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex2d)
 C
 C  Pression au sol
 C
-      call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex)
+      call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex2d)
 C
 C  Geopotentiel au sol
 C
-      call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex)
+      call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex2d)
 C
 C  Fin
 C
-      if (ok_sync) call histsync
+      if (ok_sync) then
+        call histsync(histid)
+        call histsync(histvid)
+      endif
       return
       end
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/addfi.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/addfi.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/addfi.F	(revision 79)
@@ -67,6 +67,7 @@
       REAL xpn(iim),xps(iim),tpn,tps
       INTEGER j,k,iq,ij
-      REAL qtest
-      PARAMETER ( qtest = 1.0e-30 )
+      REAL qtestw, qtestt
+      PARAMETER ( qtestw = 1.0e-15 )
+      PARAMETER ( qtestt = 1.0e-40 )
 
       REAL SSUM
@@ -81,19 +82,17 @@
       ENDDO
 
-      IF( alphax.NE.0. )   THEN
-        DO  k    = 1, llm
-         DO  ij   = 1, iim
-          xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
-          xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
-         ENDDO
-          tpn      = SSUM(iim,xpn,1)/ apoln
-          tps      = SSUM(iim,xps,1)/ apols
+      DO  k    = 1, llm
+       DO  ij   = 1, iim
+         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
+         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
+       ENDDO
+       tpn      = SSUM(iim,xpn,1)/ apoln
+       tps      = SSUM(iim,xps,1)/ apols
 
-         DO ij   = 1, iip1
-          pteta(   ij   ,k)  = tpn
-          pteta(ij+ip1jm,k)  = tps
-         ENDDO
-        ENDDO
-      ENDIF
+       DO ij   = 1, iip1
+         pteta(   ij   ,k)  = tpn
+         pteta(ij+ip1jm,k)  = tps
+       ENDDO
+      ENDDO
 c
 
@@ -114,13 +113,19 @@
          pps(j) = pps(j) + pdpfi(j) * pdt
       ENDDO
-
-c
-
-      DO iq = 1, nq
+ 
+      DO iq = 1, 2
          DO k = 1,llm
             DO j = 1,ip1jmp1
                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
-               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtest )
-ccc              pq(j,k,iq)=qtest
+               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO iq = 3, nq
+         DO k = 1,llm
+            DO j = 1,ip1jmp1
+               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
+               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
             ENDDO
          ENDDO
@@ -128,37 +133,32 @@
 
 
-      IF( alphax.NE.0. )   THEN
+      DO  ij   = 1, iim
+        xpn(ij) = aire(   ij   ) * pps(  ij     )
+        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
+      ENDDO
+      tpn      = SSUM(iim,xpn,1)/apoln
+      tps      = SSUM(iim,xps,1)/apols
 
-         DO  ij   = 1, iim
-          xpn(ij) = aire(   ij   ) * pps(  ij     )
-          xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
-         ENDDO
+      DO ij   = 1, iip1
+        pps (   ij     )  = tpn
+        pps ( ij+ip1jm )  = tps
+      ENDDO
+
+
+      DO iq = 1, nq
+        DO  k    = 1, llm
+          DO  ij   = 1, iim
+            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
+            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
+          ENDDO
           tpn      = SSUM(iim,xpn,1)/apoln
           tps      = SSUM(iim,xps,1)/apols
 
-         DO ij   = 1, iip1
-          pps (   ij     )  = tpn
-          pps ( ij+ip1jm )  = tps
-         ENDDO
-
-
-       DO iq = 1, nq
-         DO  k    = 1, llm
-           DO  ij   = 1, iim
-            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
-            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
-           ENDDO
-            tpn      = SSUM(iim,xpn,1)/apoln
-            tps      = SSUM(iim,xps,1)/apols
-
-           DO ij   = 1, iip1
+          DO ij   = 1, iip1
             pq (   ij   ,k,iq)  = tpn
             pq (ij+ip1jm,k,iq)  = tps
-           ENDDO
-         ENDDO
-       ENDDO
-
-      ENDIF
-
+          ENDDO
+        ENDDO
+      ENDDO
 
       RETURN
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/calfis.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/calfis.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/calfis.F	(revision 79)
@@ -141,4 +141,5 @@
       REAL latfi(ngridmx),lonfi(ngridmx)
       REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
 
       LOGICAL firstcal, debut
@@ -428,5 +429,6 @@
      ,   rdayvrai,rday_ecri,heure,dtphys,zplev,zplay,zphi,zphis,airefi,
      ,             presnivs,clesphy0,  zufi, zvfi,ztfi, zqfi,  
-     ,             pcvgu, pcvgv, pcvgt, pcvgq, pvervel,
+ccc     ,             pcvgu, pcvgv, pcvgt, pcvgq, 
+     ,             pvervel,
 C - sorties
      s             zdufi, zdvfi, zdtfi, zdqfi,zdpsrf              )
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/dynredem.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/dynredem.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/dynredem.F	(revision 79)
@@ -1,3 +1,4 @@
       SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
+      USE IOIPSL
       IMPLICIT NONE
 c=======================================================================
@@ -44,6 +45,16 @@
       INTEGER idim_tim
       INTEGER nid,nvarid
+
+      REAL zan0,zjulian,hours
+      INTEGER yyears0,jjour0, mmois0
+      character*30 unites
+
+
 c-----------------------------------------------------------------------
       modname='dynredem'
+
+      call ymds2ju(anneeref,1,idayref,0.0, zjulian)
+      call ju2ymds(zjulian, yyears0,mmois0,jjour0,hours)
+        
 
       DO l=1,length
@@ -353,4 +364,9 @@
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
      .                       "Temps de simulation")
+      write(unites,200)yyears0,mmois0,jjour0
+200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
+     .                         unites)
+
 c
       dims4(1) = idim_rlonu
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/etat0_netcdf.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F	(revision 79)
@@ -2,5 +2,5 @@
     
       USE startvar
-      USE IOIPSL
+      USE ioipsl
       !
       IMPLICIT NONE
@@ -20,14 +20,15 @@
       REAL :: orog(iip1,jjp1), rugo(iip1,jjp1), masque(iip1,jjp1),
      . psol(iip1, jjp1), phis(iip1, jjp1)
-      REAL :: p3d(iip1, jjp1, llmp1)
-      REAL :: uvent(iip1, jjp1, llmp1)
-      REAL :: vvent(iip1, jjm, llmp1)
-      REAL :: t3d(iip1, jjp1, llmp1), tpot(iip1, jjp1, llmp1)
-      REAL :: q3d(iip1, jjp1, llmp1,nqmx), qsat(iip1, jjp1, llmp1)
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: uvent(iip1, jjp1, llm)
+      REAL :: vvent(iip1, jjm, llm)
+      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
+      REAL :: q3d(iip1, jjp1, llm,nqmx), qsat(iip1, jjp1, llm)
       REAL :: tsol(klon), qsol(klon), sn(klon), radsol(klon)
-      REAL :: deltat(klon), rugmer(klon), agesno(klon), zmea(klon)
-      REAL :: zstd(klon), zsig(klon), zgam(klon), zthe(klon)
-      REAL :: zpic(klon), zval(klon), rugsrel(klon)
-      REAL :: qd(iip1, jjp1, llmp1)
+      REAL :: deltat(klon), rugmer(klon), agesno(klon)
+      REAL :: zmea(iip1*jjp1), zstd(iip1*jjp1)
+      REAL :: zsig(iip1*jjp1), zgam(iip1*jjp1), zthe(iip1*jjp1)
+      REAL :: zpic(iip1*jjp1), zval(iip1*jjp1), rugsrel(iip1*jjp1)
+      REAL :: qd(iip1, jjp1, llm)
       !
       CHARACTER*80 :: varname
@@ -54,5 +55,5 @@
       PARAMETER      ( longcles  = 20 )
       REAL :: clesphy0 ( longcles       )
-      REAL :: p(iip1,jjp1,llmp1)
+      REAL :: p(iip1,jjp1,llm)
       INTEGER :: itau, iday
       REAL :: masse(iip1,jjp1,llm)
@@ -62,5 +63,6 @@
       REAL :: pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
       REAL :: w(ip1jmp1,llm)
-      REAL ::phystep,radpas,co2_ppm,solaire
+      REAL ::phystep,co2_ppm,solaire
+      INTEGER :: radpas
 
       CHARACTER*80 :: visu_file
@@ -135,5 +137,5 @@
       varname = 'masque'
       ! This line needs to be replaced by a call to restget to get the values in the restart file
-      rugo(:,:) = 0.0
+      masque(:,:) = 0.0
        CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0)
       !
@@ -173,5 +175,4 @@
       phis(:,:) = 0.0
       CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0)
-      phis = phis * 9.81
       !
       varname = 'u'
@@ -283,18 +284,16 @@
       print *,' ALPHAX ',alphax
 
-      IF( alphax.NE.0. )   THEN
-       DO  l = 1, llm
-         DO  i    = 1, iim
+      DO  l = 1, llm
+        DO  i    = 1, iim
           xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
           xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
-         ENDDO
+        ENDDO
           xpn      = SUM(xppn)/apoln
           xps      = SUM(xpps)/apols
-         DO i   = 1, iip1
+        DO i   = 1, iip1
           masse(   i   ,   1     ,  l )   = xpn
           masse(   i   ,   jjp1  ,  l )   = xps
-         ENDDO
-       ENDDO
-      ENDIF
+        ENDDO
+      ENDDO
       q3d(iip1,:,:,:) = q3d(1,:,:,:)
       phis(iip1,:) = phis(1,:)
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/exner_hyb.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/exner_hyb.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/exner_hyb.F	(revision 79)
@@ -53,20 +53,18 @@
 c
       DO   ij  = 1, ngrid
-       pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
       ENDDO
 
-      IF( alphax.NE.0. )   THEN
-        DO  ij   = 1, iim
-         ppn(ij) = aire(   ij   ) * pks(  ij     )
-         pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-        ENDDO
-         xpn      = SSUM(iim,ppn,1) /apoln
-         xps      = SSUM(iim,pps,1) /apols
+      DO  ij   = 1, iim
+        ppn(ij) = aire(   ij   ) * pks(  ij     )
+        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
+      ENDDO
+      xpn      = SSUM(iim,ppn,1) /apoln
+      xps      = SSUM(iim,pps,1) /apols
 
-        DO ij   = 1, iip1
-         pks(   ij     )  =  xpn
-         pks( ij+ip1jm )  =  xps
-        ENDDO
-      ENDIF
+      DO ij   = 1, iip1
+        pks(   ij     )  =  xpn
+        pks( ij+ip1jm )  =  xps
+      ENDDO
 c
 c
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/fluxstokenc.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/dyn3d/fluxstokenc.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/fluxstokenc.F	(revision 79)
@@ -0,0 +1,172 @@
+      SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
+     . time_step,itau, fluxid, fluxvid,fluxdid )
+
+       USE IOIPSL
+c
+c     Auteur :  F. Hourdin
+c
+c
+ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "tracstoke.h"
+#include "temps.h"
+
+      REAL time_step,t_wrt, t_ops
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
+      REAL phis(ip1jmp1)
+
+      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
+      REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
+
+      REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
+
+      REAL pbarvst(iip1,jjp1,llm),zistdyn
+
+
+      INTEGER iadvtr
+      integer ndex1d(1)
+      integer ndex2d(ip1jmp1)
+      integer ndex3dv(ip1jm*llm),ndex3d(ip1jmp1*llm)
+      integer nscal
+      real tst(1),ist(1),istp(1)
+      INTEGER ij,l,irec,i,j,itau
+      INTEGER fluxid, fluxvid,fluxdid
+ 
+      SAVE iadvtr, massem,pbaruc,pbarvc,irec
+      SAVE phic,tetac
+      logical first
+      save first
+      data first/.true./
+      DATA iadvtr/0/
+
+      if(first) then
+
+	CALL initfluxsto( 'fluxstoke',
+     .  time_step,istdyn* time_step,istdyn* time_step,
+     . nqmx, fluxid,fluxvid,fluxdid) 
+	first = .false.
+
+      endif
+
+
+      ndex1d = 0
+      ndex2d = 0
+      ndex3dv = 0
+      ndex3d = 0
+
+
+      IF(iadvtr.EQ.0) THEN
+         CALL initial0(ijp1llm,phic)
+         CALL initial0(ijp1llm,tetac)
+         CALL initial0(ijp1llm,pbaruc)
+         CALL initial0(ijmllm,pbarvc)
+      ENDIF
+
+c   accumulation des flux de masse horizontaux
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
+            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
+            phic(ij,l) = phic(ij,l) + phi(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
+         ENDDO
+      ENDDO
+
+c   selection de la masse instantannee des mailles avant le transport.
+      IF(iadvtr.EQ.0) THEN
+         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
+      ENDIF
+
+      iadvtr   = iadvtr+1
+
+
+c   Test pour savoir si on advecte a ce pas de temps
+      IF ( iadvtr.EQ.istdyn ) THEN
+
+c    normalisation
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
+            tetac(ij,l) = tetac(ij,l)/float(istdyn)
+            phic(ij,l) = phic(ij,l)/float(istdyn)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
+         ENDDO
+      ENDDO
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+
+        do l=1,llm
+           do j=1,jjm
+              do i=1,iip1
+                 pbarvst(i,j,l)=pbarvg(i,j,l)
+              enddo
+           enddo
+           do i=1,iip1
+              pbarvst(i,jjp1,l)=0.
+           enddo
+        enddo
+
+         iadvtr=0
+
+c     write(*,*)'histwrite phis'
+      call histwrite(fluxid, 'phis', 1, phis, iip1*jjp1, ndex2d)
+c     write(*,*)'histwrite aire'
+      call histwrite(fluxid, 'aire', 1, aire, iip1*jjp1, ndex2d)
+	
+      nscal = 1
+      tst(1) = time_step
+c     write(*,*)'histwrite dtvr'
+      call histwrite(fluxdid, 'dtvr', 1, tst, nscal, ndex1d)
+      ist(1)=istdyn
+c     write(*,*)'histwrite istdyn'
+      call histwrite(fluxdid, 'istdyn', 1, ist, nscal, ndex1d)
+      istp(1)= istphy
+c     write(*,*)'histwrite istphy'
+      call histwrite(fluxdid, 'istphy', 1, istp, nscal, ndex1d)
+
+c       write(*,*)'histwrite masse'	
+	call histwrite(fluxid, 'masse', itau, masse,
+     .               iip1*jjp1*llm, ndex3d)
+	
+c       write(*,*)'histwrite pbaru'	
+	call histwrite(fluxid, 'pbaru', itau, pbarug,
+     .               iip1*jjp1*llm, ndex3d)
+	
+c       write(*,*)'histwrite pbarv'	
+	call histwrite(fluxvid, 'pbarv', itau, pbarvst,
+     .               iim*jjp1*llm, ndex3dv)
+	
+c       write(*,*)'histwrite w'	
+        call histwrite(fluxid, 'w' ,itau, wg, 
+     .             iip1*jjp1*llm, ndex3d) 
+	
+c       write(*,*)'histwrite teta'	
+	call histwrite(fluxid, 'teta' ,itau, tetac, 
+     .             iip1*jjp1*llm, ndex3d) 
+	
+c       write(*,*)'histwrite phi'	
+	call histwrite(fluxid, 'phi' ,itau, phic, 
+     .             iip1*jjp1*llm, ndex3d) 
+	
+C
+
+      ENDIF ! if iadvtr.EQ.istdyn
+
+      RETURN
+      END
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/gcm.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/gcm.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/gcm.F	(revision 79)
@@ -1,4 +1,6 @@
 
       PROGRAM gcm
+
+      USE IOIPSL
 
       IMPLICIT NONE
@@ -115,4 +117,5 @@
 
 
+      INTEGER fluxid, fluxvid,fluxdid
       integer histid, histvid, histaveid
       real time_step, t_wrt, t_ops
@@ -123,9 +126,13 @@
 
       LOGICAL offline  ! Controle du stockage ds "fluxmass"
-      PARAMETER (offline=.false.)
+      PARAMETER (offline=.true.)
 
       character*80 dynhist_file, dynhistave_file
       character*20 modname
       character*80 abort_message
+
+C Calendrier
+      LOGICAL true_calendar
+      PARAMETER (true_calendar = .false.)
 
 c-----------------------------------------------------------------------
@@ -138,4 +145,10 @@
       dynhist_file = 'dyn_hist.nc'
       dynhistave_file = 'dyn_hist_ave.nc'
+
+      if (true_calendar) then
+        call ioconf_calendar('gregorian')
+      else
+        call ioconf_calendar('360d')
+      endif
 c-----------------------------------------------------------------------
 c
@@ -372,5 +385,8 @@
          IF (offline) THEN
 Cmaf stokage du flux de masse pour traceurs OFF-LINE
-           CALL fluxstoke(pbaru,pbarv,masse,teta,phi,phis)
+
+            CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
+     .   time_step, itau,fluxid, fluxvid,fluxdid )
+
          ENDIF
 c
@@ -451,5 +467,4 @@
 c   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
 c
-      IF( alphax.NE. 0. ) THEN
 
         DO l  =  1, llm
@@ -467,5 +482,16 @@
         ENDDO
 
-      ENDIF
+        DO ij =  1,iim
+          tppn(ij)  = aire(  ij    ) * ps (  ij    )
+          tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
+        ENDDO
+          tpn  = SSUM(iim,tppn,1)/apoln
+          tps  = SSUM(iim,tpps,1)/apols
+
+        DO ij = 1, iip1
+          ps(  ij    ) = tpn
+          ps(ij+ip1jm) = tps
+        ENDDO
+
 
       END IF
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/grid_noro.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/grid_noro.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/grid_noro.F	(revision 79)
@@ -355,4 +355,5 @@
       DO jj=1,jmar
       zmea(imar+1,jj)=zmea(1,jj)
+      zphi(imar+1,jj)=zphi(1,jj)
       zpic(imar+1,jj)=zpic(1,jj)
       zval(imar+1,jj)=zval(1,jj)
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/integrd.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/integrd.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/integrd.F	(revision 79)
@@ -91,16 +91,14 @@
       ENDDO
 c
-      IF( alphax.NE.0. )   THEN
-        DO  ij    = 1, iim
-         tppn(ij) = aire(   ij   ) * ps(  ij    )
-         tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
-        ENDDO
-         tpn      = SSUM(iim,tppn,1)/apoln
-         tps      = SSUM(iim,tpps,1)/apols
-        DO ij   = 1, iip1
-         ps(   ij   )  = tpn
-         ps(ij+ip1jm)  = tps
-        ENDDO
-      ENDIF
+      DO  ij    = 1, iim
+       tppn(ij) = aire(   ij   ) * ps(  ij    )
+       tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
+      ENDDO
+       tpn      = SSUM(iim,tppn,1)/apoln
+       tps      = SSUM(iim,tpps,1)/apols
+      DO ij   = 1, iip1
+       ps(   ij   )  = tpn
+       ps(ij+ip1jm)  = tps
+      ENDDO
 c
 c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
@@ -136,17 +134,15 @@
 c
 c
-      IF( alphax.NE.0. )   THEN
-        DO  ij   = 1, iim
+      DO  ij   = 1, iim
         tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
         tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
-        ENDDO
+      ENDDO
         tpn      = SSUM(iim,tppn,1)/apoln
         tps      = SSUM(iim,tpps,1)/apols
 
-        DO ij   = 1, iip1
+      DO ij   = 1, iip1
         teta(   ij   ,l)  = tpn
         teta(ij+ip1jm,l)  = tps
-        ENDDO
-      ENDIF
+      ENDDO
 c
 
@@ -197,25 +193,23 @@
 c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
 c
-      IF( alphax.NE.0. )   THEN
-
-        DO iq = 1, nq
-          DO l = 1, llm
-
-             DO ij = 1, iim
+
+      DO iq = 1, nq
+        DO l = 1, llm
+
+           DO ij = 1, iim
              qppn(ij) = aire(   ij   ) * q(   ij   ,l,iq)
              qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
-             ENDDO
+           ENDDO
              qpn  =  SSUM(iim,qppn,1)/apoln
              qps  =  SSUM(iim,qpps,1)/apols
 
-             DO ij = 1, iip1
+           DO ij = 1, iip1
              q(   ij   ,l,iq)  = qpn
              q(ij+ip1jm,l,iq)  = qps
-             ENDDO
-
-          ENDDO
-        ENDDO
-
-      ENDIF
+           ENDDO
+
+        ENDDO
+      ENDDO
+
 
          CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/minmax2.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/dyn3d/minmax2.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/minmax2.F	(revision 79)
@@ -0,0 +1,17 @@
+       SUBROUTINE minmax2(imax, jmax, lmax, xi, zmin, zmax )
+c
+       INTEGER lmax,jmax,imax
+       REAL xi(imax*jmax*lmax) 
+       REAL zmin,zmax
+       INTEGER i
+    
+       zmin = xi(1)
+       zmax = xi(1)
+
+       DO i = 2, imax*jmax*lmax
+         zmin = MIN( zmin,xi(i) )
+         zmax = MAX( zmax,xi(i) )
+       ENDDO
+
+       RETURN
+       END
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/sortvarc0.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/sortvarc0.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/sortvarc0.F	(revision 79)
@@ -1,4 +1,5 @@
       SUBROUTINE sortvarc0
-     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time )
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov)
       IMPLICIT NONE
 
@@ -32,4 +33,5 @@
       INTEGER itau
       REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
       REAL ps(ip1jmp1),phis(ip1jmp1)
       REAL vorpot(ip1jm,llm)
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/startvar.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/startvar.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/startvar.F	(revision 79)
@@ -316,4 +316,5 @@
      . iml-1, jml, lon_in, lat_in, 
      . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, tmp_int)
+      phis = phis * 9.81
     !
       masque(:,:) = FLOAT(tmp_int(:,:))
@@ -660,5 +661,5 @@
               DO il=1,lml
                 xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
-                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apoln
+                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
                 champ(:,1,il) = xppn
                 champ(:,jml,il) = xpps
@@ -689,5 +690,5 @@
               DO il=1,lml
                 xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
-                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apoln
+                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
                 champ(:,1,il) = xppn
                 champ(:,jml,il) = xpps
Index: LMDZ.3.3/branches/rel-LF/libf/dyn3d/vlspltqs.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/dyn3d/vlspltqs.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/dyn3d/vlspltqs.F	(revision 79)
@@ -0,0 +1,774 @@
+       SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
+     ,                                  p,pk,teta                 )
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron 
+c
+c    ********************************************************************
+c          Shema  d'advection " pseudo amont " .
+c      + test sur humidite specifique: Q advecte< Qsat aval
+c                   (F. Codron, 10/99)
+c    ********************************************************************
+c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c     pente_max facteur de limitation des pentes: 2 en general
+c                                                0 pour un schema amont
+c     pbaru,pbarv,w flux de masse en u ,v ,w
+c     pdt pas de temps
+c
+c     teta temperature potentielle, p pression aux interfaces,
+c     pk exner au milieu des couches necessaire pour calculer Qsat
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm),pdt
+      REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+      REAL qsat(ip1jmp1,llm)
+      REAL zm(ip1jmp1,llm)
+      REAL mu(ip1jmp1,llm)
+      REAL mv(ip1jm,llm)
+      REAL mw(ip1jmp1,llm+1)
+      REAL zq(ip1jmp1,llm)
+      REAL temps1,temps2,temps3
+      REAL zzpbar, zzw
+      LOGICAL testcpu
+      SAVE testcpu
+      SAVE temps1,temps2,temps3
+
+      REAL qmin,qmax
+      DATA qmin,qmax/0.,1.e33/
+      DATA testcpu/.false./
+      DATA temps1,temps2,temps3/0.,0.,0./
+
+c--pour rapport de melange saturant--
+
+      REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
+      REAL ptarg,pdelarg,foeew,zdelta
+      REAL tempe(ip1jmp1)
+
+c    fonction psat(T)
+
+       FOEEW ( PTARG,PDELARG ) = EXP (
+     *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+
+        r2es  = 380.11733 
+        r3les = 17.269
+        r3ies = 21.875
+        r4les = 35.86
+        r4ies = 7.66
+        retv = 0.6077667
+        rtt  = 273.16
+
+c-- Calcul de Qsat en chaque point
+c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
+c   pour eviter une exponentielle.
+        DO l = 1, llm
+         DO ij = 1, ip1jmp1
+          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
+         ENDDO
+         DO ij = 1, ip1jmp1
+          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          play   = 0.5*(p(ij,l)+p(ij,l+1))
+          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
+          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
+         ENDDO
+        ENDDO
+
+c      PRINT*,'Debut vlsplt version debug sans vlyqs'
+
+        zzpbar = 0.5 * pdt
+        zzw    = pdt
+      DO l=1,llm
+        DO ij = iip2,ip1jm
+            mu(ij,l)=pbaru(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jm
+            mv(ij,l)=pbarv(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jmp1
+            mw(ij,l)=w(ij,l) * zzw
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         mw(ij,llm+1)=0.
+      ENDDO
+
+      CALL SCOPY(ijp1llm,q,1,zq,1)
+      CALL SCOPY(ijp1llm,masse,1,zm,1)
+
+c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
+
+      call vlz(zq,pente_max,zm,mw)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlxqs     ')
+
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+c     call minmaxq(zq,qmin,qmax,'apres vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M apres vlxqs     ')
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l)=zq(ij,l)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l)=q(ij,l)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL u_m( ip1jmp1,llm )
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
+      INTEGER n0,iadvplus(ip1jmp1,llm),nl(llm)
+c
+      REAL new_m,zu_m,zdum(ip1jmp1,llm)
+      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL zz(ip1jmp1)
+      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
+      REAL u_mq(ip1jmp1,llm)
+
+      Logical first,testcpu
+      SAVE first,testcpu
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+
+
+      DATA first,testcpu/.true.,.false./
+
+      IF(first) THEN
+         temps1=0.
+         temps2=0.
+         temps3=0.
+         temps4=0.
+         temps5=0.
+         first=.false.
+      ENDIF
+
+c   calcul de la pente a droite et a gauche de la maille
+
+
+      IF (pente_max.gt.-1.e-5) THEN
+c     IF (pente_max.gt.10) THEN
+
+c   calcul des pentes avec limitation, Van Leer scheme I:
+c   -----------------------------------------------------
+
+c   calcul de la pente aux points u
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
+c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+c              sigu(ij)=sigu(ij-iim)
+            ENDDO
+
+            DO ij=iip2,ip1jm
+               adxqu(ij)=abs(dxqu(ij))
+            ENDDO
+
+c   calcul de la pente maximum dans la maille en valeur absolue
+
+            DO ij=iip2+1,ip1jm
+               dxqmax(ij,l)=pente_max*
+     ,      min(adxqu(ij-1),adxqu(ij))
+c limitation subtile
+c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
+          
+
+            ENDDO
+
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqmax(ij-iim,l)=dxqmax(ij,l)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+#ifdef CRAY
+               dxq(ij,l)=
+     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
+#else
+               IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
+                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+#endif
+               dxq(ij,l)=0.5*dxq(ij,l)
+               dxq(ij,l)=
+     ,         sign(min(abs(dxq(ij,l)),dxqmax(ij,l)),dxq(ij,l))
+            ENDDO
+
+         ENDDO ! l=1,llm
+
+      ELSE ! (pente_max.lt.-1.e-5)
+
+c   Pentes produits:
+c   ----------------
+
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+               zz(ij)=dxqu(ij-1)*dxqu(ij)
+               zz(ij)=zz(ij)+zz(ij)
+               IF(zz(ij).gt.0) THEN
+                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+            ENDDO
+
+         ENDDO
+
+      ENDIF ! (pente_max.lt.-1.e-5)
+
+c   bouclage de la pente en iip1:
+c   -----------------------------
+
+      DO l=1,llm
+         DO ij=iip1+iip1,ip1jm,iip1
+            dxq(ij-iim,l)=dxq(ij,l)
+         ENDDO
+
+         DO ij=1,ip1jmp1
+            iadvplus(ij,l)=0
+         ENDDO
+
+      ENDDO
+
+
+c   calcul des flux a gauche et a droite
+
+#ifdef CRAY
+c--pas encore modification sur Qsat
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+     ,                     u_m(ij,l))
+          zdum(ij,l)=0.5*zdum(ij,l)
+          u_mq(ij,l)=cvmgp(
+     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                u_m(ij,l))
+          u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
+       ENDDO
+      ENDDO
+#else
+c   on cumule le flux correspondant a toutes les mailles dont la masse
+c   au travers de la paroi pENDant le pas de temps.
+c   le rapport de melange de l'air advecte est min(q_vanleer, Qsat_downwind)
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          IF (u_m(ij,l).gt.0.) THEN
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l),qsat(ij+1,l))
+          ELSE
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l),qsat(ij,l))
+          ENDIF
+       ENDDO
+      ENDDO
+#endif
+
+
+c   detection des points ou on advecte plus que la masse de la
+c   maille
+      DO l=1,llm
+         DO ij=iip2,ip1jm-1
+            IF(zdum(ij,l).lt.0) THEN
+               iadvplus(ij,l)=1
+               u_mq(ij,l)=0.
+            ENDIF
+         ENDDO
+      ENDDO
+      DO l=1,llm
+       DO ij=iip1+iip1,ip1jm,iip1
+          iadvplus(ij,l)=iadvplus(ij-iim,l)
+       ENDDO
+      ENDDO
+
+
+
+c   traitement special pour le cas ou on advecte en longitude plus que le
+c   contenu de la maille.
+c   cette partie est mal vectorisee.
+
+c   pas d'influence de la pression saturante (pour l'instant)
+
+c  calcul du nombre de maille sur lequel on advecte plus que la maille.
+
+      n0=0
+      DO l=1,llm
+         nl(l)=0
+         DO ij=iip2,ip1jm
+            nl(l)=nl(l)+iadvplus(ij,l)
+         ENDDO
+         n0=n0+nl(l)
+      ENDDO
+
+      IF(n0.gt.1) THEN
+ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
+ccc     &       ,'contenu de la maille : ',n0
+
+         DO l=1,llm
+            IF(nl(l).gt.0) THEN
+               iju=0
+c   indicage des mailles concernees par le traitement special
+               DO ij=iip2,ip1jm
+                  IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
+                     iju=iju+1
+                     indu(iju)=ij
+                  ENDIF
+               ENDDO
+               niju=iju
+c              PRINT*,'niju,nl',niju,nl(l)
+
+c  traitement des mailles
+               DO iju=1,niju
+                  ij=indu(iju)
+                  j=(ij-1)/iip1+1
+                  zu_m=u_m(ij,l)
+                  u_mq(ij,l)=0.
+                  IF(zu_m.gt.0.) THEN
+                     ijq=ij
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m-masse(ijq,l)
+                        i=mod(i-2+iim,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*
+     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ELSE
+                     ijq=ij+1
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(-zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m+masse(ijq,l)
+                        i=mod(i,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
+     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF  ! n0.gt.0 
+
+
+
+c   bouclage en latitude
+
+      DO l=1,llm
+        DO ij=iip1+iip1,ip1jm,iip1
+           u_mq(ij,l)=u_mq(ij-iim,l)
+        ENDDO
+      ENDDO
+
+
+c   calcul des tendances
+
+      DO l=1,llm
+         DO ij=iip2+1,ip1jm
+            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+
+     &      u_mq(ij-1,l)-u_mq(ij,l))
+     &      /new_m
+            masse(ij,l)=new_m
+         ENDDO
+c   Modif Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
+         DO ij=iip1+iip1,ip1jm,iip1
+            q(ij-iim,l)=q(ij,l)
+            masse(ij-iim,l)=masse(ij,l)
+         ENDDO
+      ENDDO
+
+c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
+c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
+
+
+      RETURN
+      END
+      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
+c     qsat 	       est   un argument de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse_adv_v( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
+      REAL qbyv(ip1jm,llm)
+
+      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+c     REAL newq,oldmasse
+      Logical first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE first,testcpu
+
+      REAL convpn,convps,convmpn,convmps
+      REAL sinlon(iip1),sinlondlon(iip1)
+      REAL coslon(iip1),coslondlon(iip1)
+      SAVE sinlon,coslon,sinlondlon,coslondlon
+      SAVE airej2,airejjm
+c
+c
+      REAL      SSUM
+      EXTERNAL  SSUM
+
+      DATA first,testcpu/.true.,.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      IF(first) THEN
+         PRINT*,'Shema  Amont nouveau  appele dans  Vanleer   '
+         first=.false.
+         do i=2,iip1
+            coslon(i)=cos(rlonv(i))
+            sinlon(i)=sin(rlonv(i))
+            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
+            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
+         ENDDO
+         coslon(1)=coslon(iip1)
+         coslondlon(1)=coslondlon(iip1)
+         sinlon(1)=sinlon(iip1)
+         sinlondlon(1)=sinlondlon(iip1)
+         airej2 = SSUM( iim, aire(iip2), 1 )
+         airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      ENDIF
+
+c
+
+
+      DO l = 1, llm
+c
+c   --------------------------------
+c      CALCUL EN LATITUDE
+c   --------------------------------
+
+c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
+c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
+c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
+
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+
+c   calcul des pentes aux points v
+
+      DO ij=1,ip1jm
+         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         adyqv(ij)=abs(dyqv(ij))
+      ENDDO
+
+c   calcul des pentes aux points scalaires
+
+      DO ij=iip2,ip1jm
+         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
+         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
+         dyqmax(ij)=pente_max*dyqmax(ij)
+      ENDDO
+
+c   calcul des pentes aux poles
+
+      DO ij=1,iip1
+         dyq(ij,l)=qpns-q(ij+iip1,l)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+      ENDDO
+
+c   filtrage de la derivee
+      dyn1=0.
+      dys1=0.
+      dyn2=0.
+      dys2=0.
+      DO ij=1,iim
+         dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
+         dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
+         dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
+         dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
+         dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
+      ENDDO
+
+c   calcul des pentes limites aux poles
+
+      fn=1.
+      fs=1.
+      DO ij=1,iim
+         IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
+            fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn)
+         ENDIF
+      IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
+         fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs)
+         ENDIF
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=fn*dyq(ij,l)
+         dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C  En memoire de dIFferents tests sur la 
+C  limitation des pentes aux poles.
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     PRINT*,dyq(1)
+C     PRINT*,dyqv(iip1+1)
+C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     PRINT*,dyq(ip1jm+1)
+C     PRINT*,dyqv(ip1jm-iip1+1)
+C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     DO ij=2,iim
+C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
+C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C     ENDDO
+C     apn=min(pente_max/apn,1.)
+C     aps=min(pente_max/aps,1.)
+C
+C
+C   cas ou on a un extremum au pole
+C
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   apn=0.
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &   aps=0.
+C
+C   limitation des pentes aux poles
+C     DO ij=1,iip1
+C        dyq(ij)=apn*dyq(ij)
+C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C     ENDDO
+C
+C   test
+C      DO ij=1,iip1
+C         dyq(iip1+ij)=0.
+C         dyq(ip1jm+ij-iip1)=0.
+C      ENDDO
+C      DO ij=1,ip1jmp1
+C         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
+C      ENDDO
+C
+C changement 10 07 96
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   THEN
+C        DO ij=1,iip1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=1,iip1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij))
+C        ENDDO
+C     ENDIF
+C
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &THEN
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
+C        ENDDO
+C     ENDIF
+C   fin changement 10 07 96
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+c   calcul des pentes limitees
+
+      DO ij=iip2,ip1jm
+         IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
+            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
+         ELSE
+            dyq(ij,l)=0.
+         ENDIF
+      ENDDO
+
+      ENDDO
+
+      DO l=1,llm
+       DO ij=1,ip1jm
+         IF( masse_adv_v(ij,l).GT.0. ) THEN
+           qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l )  +
+     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l)))
+         ELSE
+              qbyv(ij,l)= MIN( qsat(ij,l), q(ij,l) - dyq(ij,l) *
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l)) )
+         ENDIF
+          qbyv(ij,l) = masse_adv_v(ij,l)*qbyv(ij,l)
+       ENDDO
+      ENDDO
+
+
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+            newmasse=masse(ij,l)
+     &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. ancienne version
+         convpn=SSUM(iim,qbyv(1,l),1)/apoln
+         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+         DO ij = 1,iip1
+            newmasse=masse(ij,l)+convmpn*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+         convps  = -SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+         convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+         DO ij = ip1jm+1,ip1jmp1
+            newmasse=masse(ij,l)+convmps*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. fin ancienne version
+
+c._. nouvelle version
+c        convpn=SSUM(iim,qbyv(1,l),1)
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)
+c        oldmasse=ssum(iim,masse(1,l),1)
+c        newmasse=oldmasse+convmpn
+c        newq=(q(1,l)*oldmasse+convpn)/newmasse
+c        newmasse=newmasse/apoln
+c        DO ij = 1,iip1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+c        oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
+c        newmasse=oldmasse+convmps
+c        newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
+c        newmasse=newmasse/apols
+c        DO ij = ip1jm+1,ip1jmp1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c._. fin nouvelle version
+      ENDDO
+
+      RETURN
+      END
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/ajsec.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/ajsec.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/ajsec.F	(revision 79)
@@ -1,3 +1,3 @@
-      SUBROUTINE ajsec(paprs, pplay, t,q, d_t,d_q, itr, tr, d_tr)
+      SUBROUTINE ajsec(paprs, pplay, t,q, d_t,d_q)
       IMPLICIT none
 c======================================================================
@@ -16,8 +16,4 @@
       REAL t(klon,klev), q(klon,klev)
       REAL d_t(klon,klev), d_q(klon,klev)
-c
-      INTEGER it, itr
-      REAL tr(klon,klev,nbtr), d_tr(klon,klev,nbtr)
-      REAL ztr(klon,klev,nbtr), trm(nbtr)
 c
       INTEGER limbas, limhau ! les couches a ajuster
@@ -45,13 +41,4 @@
       ENDDO
       ENDDO
-      IF (itr.GE.1) THEN
-      DO it = 1, itr
-      DO k = 1, klev
-      DO i = 1, klon
-         d_tr(i,k,it) = 0.0
-      ENDDO
-      ENDDO
-      ENDDO
-      ENDIF
 c------------------------------------- detection des profils a modifier
       DO k = limbas, limhau
@@ -62,14 +49,4 @@
       ENDDO
       ENDDO
-c
-      IF (itr.GE.1) THEN
-      DO it = 1, itr
-      DO k = limbas, limhau
-      DO i = 1, klon
-         ztr(i,k,it) = tr(i,k,it)
-      ENDDO
-      ENDDO
-      ENDDO
-      ENDIF
 c
       DO k = limbas, limhau
@@ -102,19 +79,8 @@
               hm = zh(i,k2)
               qm = zq(i,k2)
-              IF (itr.GE.1) THEN
-              DO it = 1, itr
-                trm(it) = ztr(i,k2,it)
-              ENDDO
-              ENDIF
  8020         CONTINUE
                 sm = sm +zpkdp(i,k)
                 hm = hm +zpkdp(i,k) * (zh(i,k)-hm) / sm
                 qm = qm +zpkdp(i,k) * (zq(i,k)-qm) / sm
-                IF (itr.GE.1) THEN
-                DO it = 1, itr
-                trm(it) = trm(it) +
-     .                    zpkdp(i,k) * (ztr(i,k,it)-trm(it)) / sm
-                ENDDO
-                ENDIF
                 down = .FALSE.
                 IF (k1 .ne. limbas) THEN
@@ -137,11 +103,4 @@
                 zq(i,k) = qm
               ENDDO
-              IF (itr.GE.1) THEN
-              DO it = 1, itr
-              DO k = k1, k2
-                ztr(i,k,it) = trm(it)
-              ENDDO
-              ENDDO
-              ENDIF
               k2 = k2 + 1
             ENDIF
@@ -173,32 +132,4 @@
          d_q(i,k) = 0.0
       ENDDO
-      ENDDO
-      ENDIF
-c
-      IF (itr.GE.1) THEN
-      DO it = 1, itr
-c
-      DO k = limbas, limhau
-      DO i = 1, klon
-         d_tr(i,k,it) = ztr(i,k,it) - tr(i,k,it)
-      ENDDO
-      ENDDO
-c
-      IF (limbas.GT.1) THEN
-      DO k = 1, limbas-1
-      DO i = 1, klon
-         d_tr(i,k,it) = 0.0
-      ENDDO
-      ENDDO
-      ENDIF
-c
-      IF (limhau.LT.klev) THEN
-      DO k = limhau+1, klev
-      DO i = 1, klon
-         d_tr(i,k,it) = 0.0
-      ENDDO
-      ENDDO
-      ENDIF
-c
       ENDDO
       ENDIF
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/albedo.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/albedo.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/albedo.F	(revision 79)
@@ -17,5 +17,6 @@
 c
       REAL fmagic ! un facteur magique pour regler l'albedo
-      PARAMETER (fmagic=0.7)
+ccc      PARAMETER (fmagic=0.7)
+      PARAMETER (fmagic=1.1)
       INTEGER npts ! il controle la precision de l'integration
       PARAMETER (npts=120) ! 120 correspond a l'interval 6 minutes
@@ -83,4 +84,8 @@
       REAL rmu0(klon), albedo(klon)
 c
+      REAL fmagic ! un facteur magique pour regler l'albedo
+ccc      PARAMETER (fmagic=0.7)
+      PARAMETER (fmagic=1.1)
+c
       REAL fauxo
       INTEGER i
@@ -88,5 +93,5 @@
       DO i = 1, klon
          fauxo = ( 1.47 - ACOS( rmu0(i) ) )/0.15
-         albedo(i) = 1.1*( .03 + .630/( 1. + fauxo*fauxo))
+         albedo(i) = fmagic*( .03 + .630/( 1. + fauxo*fauxo))
          albedo(i) = MAX(MIN(albedo(i),0.60),0.04)
       ENDDO
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/clmain.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F	(revision 79)
@@ -122,4 +122,7 @@
 cAA      REAL yflxsrf(klon,nbtr)
 c
+      LOGICAL contreg
+      PARAMETER (contreg=.TRUE.)
+c
       LOGICAL ok_nonloc
       PARAMETER (ok_nonloc=.FALSE.)
@@ -272,4 +275,12 @@
      .            yts, yrugos, yu, yv, yt, yq,
      .            ycoefm, ycoefh)
+      CALL coefkz2(nsrf, knon, paprs, pplay,t,
+     .                  ycoefm0, ycoefh0)
+      DO k = 1, klev
+      DO i = 1, knon
+         ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
+         ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
+      ENDDO
+      ENDDO
 c
 c parametrisation non-locale:
@@ -289,4 +300,12 @@
          ENDDO
       ELSE
+         IF (.NOT.contreg) THEN
+            DO k = 2, klev
+            DO i = 1, knon
+               ygamq(i,k) = 0.0
+               ygamt(i,k) = 0.0
+            ENDDO
+            ENDDO
+         ELSE
          DO k = 3, klev
          DO i = 1, knon
@@ -299,4 +318,5 @@
             ygamt(i,2) = -2.5E-03
          ENDDO
+         ENDIF
       ENDIF
 c
@@ -873,5 +893,5 @@
       PARAMETER (clam=160.0)
       REAL ratqs ! largeur de distribution de vapeur d'eau
-      PARAMETER (ratqs=0.2)
+      PARAMETER (ratqs=0.05)
       LOGICAL richum ! utilise le nombre de Richardson humide
       PARAMETER (richum=.TRUE.)
@@ -881,5 +901,5 @@
       PARAMETER (prandtl=0.4)
       REAL kstable ! diffusion minimale (situation stable)
-      PARAMETER (kstable=1.0e-06)
+      PARAMETER (kstable=1.0e-10)
       REAL mixlen ! constante controlant longueur de melange
       PARAMETER (mixlen=35.0)
@@ -950,5 +970,5 @@
 c Prescrire la valeur de contre-gradient
 c
-      IF (contreg) THEN
+      IF (.NOT.contreg) THEN
          DO k = 2, klev
             gamt(k) = 0.0
@@ -1131,4 +1151,101 @@
       RETURN
       END
+      SUBROUTINE coefkz2(nsrf, knon, paprs, pplay,t,
+     .                  pcfm, pcfh)
+      IMPLICIT none
+c======================================================================
+c J'introduit un peu de diffusion sauf dans les endroits
+c ou une forte inversion est presente
+c On peut dire qu'il represente la convection peu profonde
+c
+c Arguments:
+c nsrf-----input-I- indicateur de la nature du sol
+c knon-----input-I- nombre de points a traiter
+c paprs----input-R- pression a chaque intercouche (en Pa)
+c pplay----input-R- pression au milieu de chaque couche (en Pa)
+c t--------input-R- temperature (K)
+c
+c pcfm-----output-R- coefficients a calculer (vitesse)
+c pcfh-----output-R- coefficients a calculer (chaleur et humidite)
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+#include "indicesol.h"
+c
+c Arguments:
+c
+      INTEGER knon, nsrf
+      REAL paprs(klon,klev+1), pplay(klon,klev)
+      REAL t(klon,klev)
+c
+      REAL pcfm(klon,klev), pcfh(klon,klev)
+c
+c Quelques constantes et options:
+c
+      REAL prandtl
+      PARAMETER (prandtl=0.4)
+      REAL kstable
+      PARAMETER (kstable=0.002)
+ccc      PARAMETER (kstable=0.001)
+      REAL mixlen ! constante controlant longueur de melange
+      PARAMETER (mixlen=35.0)
+      REAL seuil ! au-dela l'inversion est consideree trop faible
+      PARAMETER (seuil=-0.02)
+ccc      PARAMETER (seuil=-0.04)
+ccc      PARAMETER (seuil=-0.06)
+ccc      PARAMETER (seuil=-0.09)
+c
+c Variables locales:
+c
+      INTEGER i, k, invb(klon)
+      REAL zl2(klon)
+      REAL zdthmin(klon), zdthdp
+c
+c Initialiser les sorties
+c
+      DO k = 1, klev
+      DO i = 1, knon
+         pcfm(i,k) = 0.0
+         pcfh(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+c Chercher la zone d'inversion forte
+c
+      DO i = 1, klon
+         invb(i) = klev
+         zdthmin(i)=0.0
+      ENDDO
+      DO k = 2, klev/2-1
+      DO i = 1, klon
+         zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
+     .          - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
+         zdthdp = zdthdp * 100.0
+         IF (pplay(i,k).GT.0.8*paprs(i,1) .AND.
+     .       zdthdp.LT.zdthmin(i) ) THEN
+            zdthmin(i) = zdthdp
+            invb(i) = k
+         ENDIF
+      ENDDO
+      ENDDO
+c
+c Introduire une diffusion:
+c
+      DO k = 2, klev
+      DO i = 1, knon
+      IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
+     .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
+     .     (zdthmin(i).GT.seuil) )THEN ! si l'inversion est trop faible
+         zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,klev+1))
+     .                       /(paprs(i,2)-paprs(i,klev+1)) ))**2
+         pcfm(i,k)= zl2(i)* kstable
+         pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
+      ENDIF
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
       SUBROUTINE calbeta(dtime,indice,snow,qsol,
      .                    vbeta,vcal,vdif)
@@ -1146,5 +1263,6 @@
 #include "indicesol.h"
       REAL tau_gl ! temps de relaxation pour la glace de mer
-      PARAMETER (tau_gl=86400.0*30.0)
+ccc      PARAMETER (tau_gl=86400.0*30.0)
+      PARAMETER (tau_gl=86400.0*5.0)
       REAL mx_eau_sol
       PARAMETER (mx_eau_sol=150.0)
@@ -1178,6 +1296,6 @@
           IF (snow(i,is_sic) .GT. 0.0) vcal(i) = calsno
           vbeta(i)  = 1.0
-ccc          vdif(i) = 1.0/tau_gl ! c'etait une erreur
-          vdif(i) = calice/tau_gl
+          vdif(i) = 1.0/tau_gl
+ccc          vdif(i) = calice/tau_gl ! c'etait une erreur
       ENDDO
       ENDIF
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/condsurf.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/condsurf.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/condsurf.F	(revision 79)
@@ -43,9 +43,4 @@
       REAL lmt_rug(klon) ! longeur de rugosite du sol
       REAL lmt_bils(klon)
-c
-c Couplage OASIS:
-#include "oasis.h"
-      REAL cpl_sst(iim,jjm+1), cpl_sic(iim,jjm+1)
-      REAL cpl_alb_sst(iim,jjm+1), cpl_alb_sic(iim,jjm+1)
 c
 c Variables locales:
@@ -299,52 +294,4 @@
       PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour
 c
-      IF (ok_oasis) THEN
-C
-         CALL fromcpl(jour,(jjm+1)*iim,
-     .        cpl_sst,cpl_sic,cpl_alb_sst,cpl_alb_sic)
-         DO i = 1, iim-1 ! un seul point pour le pole nord
-            cpl_sst(i,1) = cpl_sst(iim,1)
-            cpl_sic(i,1) = cpl_sic(iim,1)
-            cpl_alb_sst(i,1) = cpl_alb_sst(iim,1)
-            cpl_alb_sic(i,1) = cpl_alb_sic(iim,1)
-         ENDDO
-         DO i = 2, iim ! un seul point pour le pole sud
-            cpl_sst(i,jjm+1) = cpl_sst(1,jjm+1)
-            cpl_sic(i,jjm+1) = cpl_sic(1,jjm+1)
-            cpl_alb_sst(i,jjm+1) = cpl_alb_sst(1,jjm+1)
-            cpl_alb_sic(i,jjm+1) = cpl_alb_sic(1,jjm+1)
-         ENDDO
-c
-         ig = 1
-         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
-     .       pctsrf(ig,is_sic).GT.epsfra) THEN
-            pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
-     .                        - (cpl_sic(1,1)-pctsrf(ig,is_sic))
-            pctsrf(ig,is_sic) = cpl_sic(1,1)
-            lmt_sst(ig) = cpl_sst(1,1)
-         ENDIF
-         DO j = 2, jjm
-         DO i = 1, iim
-         ig = ig + 1
-         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
-     .       pctsrf(ig,is_sic).GT.epsfra) THEN
-           pctsrf(ig,is_oce) = pctsrf(ig,is_oce) 
-     .                       - (cpl_sic(i,j)-pctsrf(ig,is_sic))
-           pctsrf(ig,is_sic) = cpl_sic(i,j)
-           lmt_sst(ig) = cpl_sst(i,j)
-         ENDIF
-         ENDDO
-         ENDDO
-         ig = ig + 1
-         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
-     .       pctsrf(ig,is_sic).GT.epsfra) THEN
-            pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
-     .                        - (cpl_sic(1,jjm+1)-pctsrf(ig,is_sic))
-            pctsrf(ig,is_sic) = cpl_sic(1,jjm+1)
-            lmt_sst(ig) = cpl_sst(1,jjm+1)
-         ENDIF
-c
-      ENDIF ! ok_oasis
-c
       RETURN
       END
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/conflx.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/conflx.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/conflx.F	(revision 79)
@@ -65,4 +65,6 @@
       REAL zde_u(klon,klev)
       REAL zde_d(klon,klev)
+      REAL zmflxr(klon,klev+1)
+      REAL zmflxs(klon,klev+1)
 cAA
 
@@ -150,5 +152,5 @@
      .             rain, snow, kcbot, kctop, kdtop,
      .             zmfu, zmfd, zen_u, zde_u, zen_d, zde_d,
-     .             d_t_bis, d_q_bis, pmflxr, pmflxs)
+     .             d_t_bis, d_q_bis, zmflxr, zmflxs)
 C
 cAA--------------------------------------------------------
@@ -193,5 +195,11 @@
       ENDDO
 
-c
+      DO k = 1, klev+1
+      DO i = 1, klon
+         pmflxr(i,klev+2-k)= zmflxr(i,k)
+         pmflxs(i,klev+2-k)= zmflxs(i,k)
+      ENDDO
+      ENDDO
+
       RETURN
       END
@@ -309,5 +317,6 @@
       DO i = 1, klon
          ktype(i) = 2
-         if (zdqcv(i).GT.MAX(0.,-1.1*pqhfl(i)*RG)) ktype(i) = 1
+         if (zdqcv(i).GT.MAX(0.,-1.5*pqhfl(i)*RG)) ktype(i) = 1
+ccc         if (zdqcv(i).GT.MAX(0.,-1.1*pqhfl(i)*RG)) ktype(i) = 1
       ENDDO
 c
@@ -1539,4 +1548,9 @@
       zalsdcp = rlstt/RCPD
 C
+
+      DO i = 1, klon
+         zcond(i) = 0.0
+      ENDDO
+
       DO 210 i =1, klon
       IF (ldflag(i)) THEN
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/conlmd.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/conlmd.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/conlmd.F	(revision 79)
@@ -126,10 +126,8 @@
       INTEGER nb ! nombre de sous-fractions a considere
       PARAMETER (nb=1)
-ccc      PARAMETER (nb=5)
 ccc      PARAMETER (nb=3)
 c
       REAL ratqs ! largeur de la distribution pour vapeur d'eau
-      PARAMETER (ratqs=0.2)
-c
+      PARAMETER (ratqs=0.05)
 c
       REAL w_q(klon,klev)
@@ -167,8 +165,6 @@
       DATA frac / 1.0 /
       DATA opt_cld / 4 /
-ccc      DATA frac    / 1.0, 0.75, 0.50, 0.25, 0.05 /
-ccc      DATA opt_cld / 3,   3,    3,    3,    3 /
 ccc      DATA frac    / 1.0, 0.50, 0.25/
-ccc      DATA opt_cld / 3,   3,    3/
+ccc      DATA opt_cld / 4,   4,    4/
 c
       DATA appel1er /.TRUE./
@@ -248,5 +244,6 @@
          zflo = t(i,k) + zgamdz - t(i,k+1)
          zsat = (q(i,k)-zqs1)*zdp1 + (q(i,k+1)-zqs2)*zdp2
-         IF (zflo.GT.0.0 .AND. zsat.GT.0.0) afaire(i) = .TRUE.
+         IF (zflo.GT.0.0) afaire(i) = .TRUE.
+c erreur         IF (zflo.GT.0.0 .AND. zsat.GT.0.0) afaire(i) = .TRUE.
       ENDDO
       ENDDO
@@ -339,5 +336,5 @@
       PARAMETER (new_top=.FALSE.)
       LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-      PARAMETER (evap_prec=.FALSE.)
+      PARAMETER (evap_prec=.TRUE.)
       REAL coef_eva
       PARAMETER (coef_eva=1.0E-05)
@@ -350,9 +347,14 @@
       REAL toliq(klon) ! rapport entre l'eau nuageuse et l'eau precipitante
       REAL dpmin, tomax !Epaisseur faible, rapport eau liquide plus grande
-      PARAMETER (dpmin=0.1, tomax=0.2)
+      PARAMETER (dpmin=0.15, tomax=0.97)
       REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-      PARAMETER (dpmax=0.6, tomin=0.1)
+      PARAMETER (dpmax=0.30, tomin=0.05)
+      REAL deep_sig, deep_to ! au dela de deep_sig, utiliser deep_to
+      PARAMETER (deep_sig=0.50, deep_to=0.05)
       LOGICAL exigent ! implique un calcul supplementaire pour Qs
       PARAMETER (exigent=.FALSE.)
+c
+      INTEGER kbase
+      PARAMETER (kbase=0)
 c
 c Variables locales:
@@ -479,6 +481,6 @@
       DO i = 1, klon
       IF (possible(i)) THEN
-         k1(i) = 0
-         k2(i) = 1
+         k1(i) = kbase
+         k2(i) = k1(i) + 1
       ENDIF
       ENDDO
@@ -688,4 +690,5 @@
      .                 *(tomax-tomin)/(dpmax-dpmin)
       toliq(i) = MAX(tomin,MIN(tomax,toliq(i)))
+      IF (pplay(i,k2(i))/paprs(i,1) .LE. deep_sig) toliq(i) = deep_to
       IF (old_tau) toliq(i) = 1.0
       ENDIF
@@ -787,5 +790,6 @@
       ELSE IF (opt_cld.EQ.4) THEN
 c
-         nexpo = 1 ! distribution lineaire
+         nexpo = 3
+ccc         nexpo = 1 ! distribution lineaire
 c
          DO i = 1, klon
@@ -927,9 +931,12 @@
       k1max = 1
       DO i = 1, klon
-      IF (todo(i) .AND. k1(i).GT.1) THEN
+      IF (todo(i) .AND. k1(i).GT.(kbase+1)) THEN
          k = k1(i)
          zflo(i) = zt(i,k-1) + zgamdz(i,k-1) - zt(i,k)
          zsat(i) = zqmqsdp(i,k) + zqmqsdp(i,k-1)
-         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) THEN
+csc voici l'ancienne ligne:
+csc         IF (zflo(i).LE.0.0 .OR. zsat(i).LE.0.0) THEN
+csc sylvain: il faut RESPECTER les 2 criteres:
+         IF (zflo(i).GT.0.0 .AND. zsat(i).GT.0.0) THEN
             etendre(i) = .TRUE.
             k1(i) = k1(i) - 1
@@ -940,6 +947,6 @@
       ENDDO
 c
-      IF (k1max.GT.1) THEN
-      DO k = k1max, 1, -1
+      IF (k1max.GT.(kbase+1)) THEN
+      DO k = k1max, kbase+1, -1
       DO i = 1, klon
       IF (etendre(i) .AND. k.LT.k1(i) .AND. aller(i)) THEN
@@ -1095,5 +1102,5 @@
       PARAMETER (opt_cld=4) ! valeur possible: 0, 1, 2, 3 ou 4
       LOGICAL evap_prec ! evaporation de pluie au-dessous de convection
-      PARAMETER (evap_prec=.FALSE.)
+      PARAMETER (evap_prec=.TRUE.)
       REAL coef_eva
       PARAMETER (coef_eva=1.0E-05)
@@ -1106,7 +1113,9 @@
       REAL toliq(klon) ! rapport entre l'eau nuageuse et l'eau precipitante
       REAL dpmin, tomax !Epaisseur faible, rapport eau liquide plus grande
-      PARAMETER (dpmin=0.1, tomax=0.2)
+      PARAMETER (dpmin=0.15, tomax=0.97)
       REAL dpmax, tomin !Epaisseur grande, rapport eau liquide plus faible
-      PARAMETER (dpmax=0.6, tomin=0.1)
+      PARAMETER (dpmax=0.30, tomin=0.05)
+      REAL deep_sig, deep_to ! au dela de deep_sig, utiliser deep_to
+      PARAMETER (deep_sig=0.50, deep_to=0.05)
 c
 c Variables locales:
@@ -1383,4 +1392,5 @@
      .             *(tomax-tomin)/(dpmax-dpmin)
       toliq(i) = MAX(tomin,MIN(tomax,toliq(i)))
+      IF (pplay(i,kh(i))/paprs(i,1) .LE. deep_sig) toliq(i) = deep_to
       IF (old_tau) toliq(i) = 1.0
       ENDIF
@@ -1497,5 +1507,6 @@
       ELSE IF (opt_cld.EQ.4) THEN
 c
-         nexpo = 1 ! distribution lineaire
+         nexpo = 3
+ccc         nexpo = 1 ! distribution lineaire
 c
          DO i = 1, klon
@@ -1708,4 +1719,8 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
+c
+      DO i = 1, klon
+         zcond(i) = 0.0
+      ENDDO
 C
       DO 210 i=1, klon
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/fisrtilp.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp.F	(revision 79)
@@ -1,4 +1,5 @@
       SUBROUTINE fisrtilp(dtime,paprs,pplay,t,q,
-     s                   d_t, d_q, d_ql, rneb, radliq, rain, snow)
+     s                   d_t, d_q, d_ql, rneb, radliq, rain, snow,
+     s                   prfl, psfl)
 c
       IMPLICIT none
@@ -28,4 +29,6 @@
       REAL rain(klon) ! pluies (mm/s)
       REAL snow(klon) ! neige (mm/s)
+      REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
+      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
 c
 c Options du programme:
@@ -36,5 +39,7 @@
       PARAMETER (ct=1./1800.)
       REAL cl ! seuil de precipitation
-      PARAMETER (cl=2.0e-4)
+      PARAMETER (cl=2.6e-4)
+ccc      PARAMETER (cl=2.3e-4)
+ccc      PARAMETER (cl=2.0e-4)
       INTEGER ninter ! sous-intervals pour la precipitation
       PARAMETER (ninter=5)
@@ -77,6 +82,7 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-CCC      fallv (zzz) = 3.29/3.0 * ((zzz)**0.
-       fallv (zzz) = 3.29 * ((zzz)**0.16)
+      fallv (zzz) = 3.29/2.0 * ((zzz)**0.16)
+ccc      fallv (zzz) = 3.29/3.0 * ((zzz)**0.16)
+ccc      fallv (zzz) = 3.29 * ((zzz)**0.16)
 c
       DATA appel1er /.TRUE./
@@ -103,4 +109,10 @@
 c Initialiser les sorties:
 c
+      DO k = 1, klev+1
+      DO i = 1, klon
+         prfl(i,k) = 0.0
+         psfl(i,k) = 0.0
+      ENDDO
+      ENDDO
       DO k = 1, klev
       DO i = 1, klon
@@ -205,5 +217,6 @@
             zx = zx * zx * zx
             ratqs = zx * (rat_max-rat_min) + rat_min
-            IF (.NOT.calcrat) ratqs=0.2
+            IF (.NOT.calcrat) ratqs=0.05
+ccc            IF (.NOT.calcrat) ratqs=0.2
 c
             zdelq = ratqs * zq(i)
@@ -269,4 +282,9 @@
      .                    * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
       ENDIF
+      IF (zt(i).LT.RTT) THEN
+        psfl(i,k)=zrfl(i)
+      ELSE
+        prfl(i,k)=zrfl(i)
+      ENDIF
       ENDDO
 c
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp_tr.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/fisrtilp_tr.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/fisrtilp_tr.F	(revision 79)
@@ -2,5 +2,6 @@
      s                   d_t, d_q, d_ql, rneb, radliq, rain, snow,
      s                   pfrac_impa, pfrac_nucl, pfrac_1nucl,
-     s                   frac_impa, frac_nucl )
+     s                   frac_impa, frac_nucl,
+     s                   prfl, psfl)
 
 c
@@ -32,4 +33,6 @@
       REAL rain(klon) ! pluies (mm/s)
       REAL snow(klon) ! neige (mm/s)
+      REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
+      REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s)
 cAA
 c Coeffients de fraction lessivee : pour OFF-LINE
@@ -53,5 +56,7 @@
       PARAMETER (ct=1./1800.)
       REAL cl ! seuil de precipitation
-      PARAMETER (cl=2.0e-4)
+      PARAMETER (cl=2.6e-4)
+ccc      PARAMETER (cl=2.3e-4)
+ccc      PARAMETER (cl=2.0e-4)
       INTEGER ninter ! sous-intervals pour la precipitation
       PARAMETER (ninter=5)
@@ -62,5 +67,5 @@
       LOGICAL calcrat ! calculer ratqs au lieu de fixer sa valeur
       REAL ratqs ! determine la largeur de distribution de vapeur
-      PARAMETER (calcrat=.FALSE.)
+      PARAMETER (calcrat=.TRUE.)
       REAL zx_min, rat_max
       PARAMETER (zx_min=1.0, rat_max=0.01)
@@ -101,5 +106,5 @@
       REAL zalpha_tr
       REAL zfrac_lessi
-      REAL zprec_cond
+      REAL zprec_cond(klon)
 cAA
 c---------------------------------------------------------------
@@ -111,5 +116,7 @@
 #include "YOETHF.h"
 #include "FCTTRE.h"
-      fallv (zzz) = 3.29 * ((zzz)**0.16)
+      fallv (zzz) = 3.29/2.0 * ((zzz)**0.16)
+ccc      fallv (zzz) = 3.29/3.0 * ((zzz)**0.16)
+ccc      fallv (zzz) = 3.29 * ((zzz)**0.16)
 c
       DATA appel1er /.TRUE./
@@ -158,4 +165,11 @@
 c Initialiser les sorties:
 c
+      DO k = 1, klev+1
+      DO i = 1, klon
+         prfl(i,k) = 0.0
+         psfl(i,k) = 0.0
+      ENDDO
+      ENDDO
+
       DO k = 1, klev
       DO i = 1, klon
@@ -186,5 +200,4 @@
       zalpha_tr   = 0.
       zfrac_lessi = 0.
-      zprec_cond  = 0.
 
 cAA----------------------------------------------------------
@@ -273,5 +286,5 @@
             zx = zx * zx * zx
             ratqs = zx * (rat_max-rat_min) + rat_min
-            IF (.NOT.calcrat) ratqs=0.2
+            IF (.NOT.calcrat) ratqs=0.05
 c
             zdelq = ratqs * zq(i)
@@ -337,4 +350,9 @@
      .                    * (paprs(i,k)-paprs(i,k+1))/(RG*dtime)
       ENDIF
+      IF (zt(i).LT.RTT) THEN
+        psfl(i,k)=zrfl(i)
+      ELSE
+        prfl(i,k)=zrfl(i)
+      ENDIF
       ENDDO
 c
@@ -350,7 +368,7 @@
       DO i = 1,klon
 c
-             zprec_cond = MAX(zcond(i)-zoliq(i),0.0)
+         zprec_cond(i) = MAX(zcond(i)-zoliq(i),0.0)
      .                * (paprs(i,k)-paprs(i,k+1))/RG
-         IF (rneb(i,k).GT.0.0.and.zprec_cond.gt.0.) THEN
+         IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
 cAA lessivage nucleation LMD5 dans la couche elle-meme
             if (t(i,k) .GE. ztglace) THEN
@@ -359,25 +377,30 @@
                zalpha_tr = a_tr_sca(4)
             endif
-            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond/zneb(i))
+            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
             pfrac_nucl(i,k)=pfrac_nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
             frac_nucl(i,k)= 1.-zneb(i)*zfrac_lessi 
 c
 c nucleation avec un facteur -1 au lieu de -0.5
-            zfrac_lessi = 1. - EXP(-zprec_cond/zneb(i))
+            zfrac_lessi = 1. - EXP(-zprec_cond(i)/zneb(i))
             pfrac_1nucl(i,k)=pfrac_1nucl(i,k)*(1.-zneb(i)*zfrac_lessi)
+         ENDIF
+c
+      ENDDO      ! boucle sur i
+c
 cAA Lessivage par impaction dans les couches en-dessous
-            do kk=k-1,1,-1
-              if (t(i,kk) .GE. ztglace) THEN
-                 zalpha_tr = a_tr_sca(1)
-              else
-                 zalpha_tr = a_tr_sca(2)
-              endif
-              zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond/zneb(i))
-              pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
-              frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi 
-            enddo
-         ENDIF
-c
-      ENDDO      ! boucle sur i
+      DO kk = k-1, 1, -1
+        DO i = 1, klon
+          IF (rneb(i,k).GT.0.0.and.zprec_cond(i).gt.0.) THEN
+            if (t(i,kk) .GE. ztglace) THEN
+              zalpha_tr = a_tr_sca(1)
+            else
+              zalpha_tr = a_tr_sca(2)
+            endif
+            zfrac_lessi = 1. - EXP(zalpha_tr*zprec_cond(i)/zneb(i))
+            pfrac_impa(i,kk)=pfrac_impa(i,kk)*(1.-zneb(i)*zfrac_lessi)
+            frac_impa(i,kk)= 1.-zneb(i)*zfrac_lessi
+          ENDIF
+        ENDDO
+      ENDDO
 c
 cAA----------------------------------------------------------
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/inc_cpl.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/inc_cpl.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/inc_cpl.h	(revision 79)
@@ -0,0 +1,16 @@
+C
+C -- inc_cpl.h  
+C    **********
+C@
+C@  Contents : variables describing field restart file names 
+C@  --------
+C@
+C@ -- cl_write/cl_read  : for fields to write/READ
+C@ -- cl_f_write/cl_f_read  : for fields to write/read
+C@
+C     -------------------------------------------------------------------
+C
+      CHARACTER*8 cl_writ(jpmaxfld), cl_read(jpmaxfld)
+      CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld)
+      COMMON / comcpl / cl_writ, cl_read, cl_f_writ, cl_f_read
+C     -------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/inc_sipc.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/inc_sipc.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/inc_sipc.h	(revision 79)
@@ -0,0 +1,23 @@
+C
+C -- inc_sipc.h   97-08-11   Version 2.0   Author: S&A
+C    **********
+C@
+C@  Contents : variables describing pools formed of shared memory segments 
+C@  --------
+C@
+C@ -- mpoolinit(r/w) : handles associated to model pools for passing initial info
+C@
+C@ -- mpoolwrit : handles associated to pools used to pass fields exchanged 
+C@               from model to coupler (see libsipc/SIPC_Write_Model.f)
+C@
+C@ -- mpoolread : handles associated to pools used to pass fields exchanged
+C@               from model to coupler (see libsipc/SIPC_Read_Model.f) 
+C@ 
+C     -------------------------------------------------------------------
+C
+      INTEGER  mpoolinitr
+      INTEGER  mpoolinitw
+      INTEGER  mpoolwrit(jpflda2o)
+      INTEGER  mpoolread(jpfldo2a)
+      COMMON / compool / mpoolinitr, mpoolinitw, mpoolwrit, mpoolread
+C     -------------------------------------------------------------------
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/initphysto.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/initphysto.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/initphysto.F	(revision 79)
@@ -0,0 +1,273 @@
+      subroutine initphysto
+     .  (infile,
+     .  rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)
+
+       USE IOIPSL
+
+      implicit none
+
+C
+C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
+C   au format IOIPSL
+C
+C   Appels succesifs des routines: histbeg
+C                                  histhori
+C                                  histver
+C                                  histdef
+C                                  histend
+C
+C   Entree:
+C
+C      infile: nom du fichier histoire a creer
+C      day0,anne0: date de reference
+C      tstep: duree du pas de temps en seconde
+C      t_ops: frequence de l'operation pour IOIPSL
+C      t_wrt: frequence d'ecriture sur le fichier
+C      nq: nombre de traceurs
+C
+C   Sortie:
+C      fileid: ID du fichier netcdf cree
+C      filevid:ID du fichier netcdf pour la grille v
+C
+C   L. Fairhead, LMD, 03/99
+C
+C =====================================================================
+C
+C   Declarations
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "indicesol.h"
+#include "control.h"
+#include "dimphy.h"
+
+C   Arguments
+      character*(*) infile
+      integer*4 nhoriid, i
+      real tstep, t_ops, t_wrt
+      integer fileid, filevid
+      integer nq,l
+      real nivsigs(llm)
+
+C   Variables locales
+C
+      integer tau0
+      real zjulian
+      character*3 str
+      character*10 ctrac
+      integer iq
+      integer uhoriid, vhoriid, thoriid, zvertiid
+      integer ii,jj
+      integer zan
+      logical ok_sync
+      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
+C
+      REAL rlon(klon), rlat(klon)
+
+C  Initialisations
+C
+      pi = 4. * atan (1.)
+      str='q  '
+      ctrac = 'traceur   '
+      ok_sync= .true.
+C
+C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
+C         
+
+      zan = anneeref
+      CALL ymds2ju(zan, 1, 1, 0.0, zjulian)
+      zjulian = zjulian + dayref
+      tau0 = 0
+	
+	CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
+         DO i = 1, iim
+            zx_lon(i,1) = rlon(i+1)
+            zx_lon(i,jjm+1) = rlon(i+1)
+         ENDDO
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
+
+
+      call histbeg(infile, iim, zx_lon, jjm+1, zx_lat,
+     .             1, iim, 1, jjm+1,
+     .             tau0, zjulian, tstep, nhoriid, fileid)
+
+C  Appel a histvert pour la grille verticale
+C
+	DO l=1,llm
+            nivsigs(l)=float(l)
+         ENDDO
+	
+	write(*,*) 'avant histvert ds initphysto'
+
+      call histvert(fileid, 'sig_s', 'Niveaux sigma',
+     . 'sigma_level',
+     .              llm, nivsigs, zvertiid)
+C
+C  Appels a histdef pour la definition des variables a sauvegarder
+C
+	write(*,*) 'apres histvert ds initphysto'
+
+       CALL histdef(fileid, "phis", "Surface geop. height", "-",
+     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+c
+	write(*,*) 'apres phis ds initphysto'
+
+         CALL histdef(fileid, "aire", "Grid area", "-",
+     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+         write(*,*) 'apres aire ds initphysto'
+
+         CALL histdef(fileid, "dtime", "tps phys ", "s",
+     .                1,1,nhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+	
+	 CALL histdef(fileid, "istphy", "tps stock", "s",
+     .                1,1,nhoriid, 1,1,1, -99, 32,
+     .                "once", t_ops, t_wrt)
+
+C mfu 
+C
+      call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+        write(*,*) 'apres mfu ds initphysto'
+C
+C mfd 
+C
+      call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C en_u 
+C
+      call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+               write(*,*) 'apres en_u ds initphysto'
+C
+C de_u 
+C
+      call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+C
+C en_d 
+C
+      call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+C
+
+C
+C de_d 
+C
+      call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+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)
+	
+	write(*,*) 'apres coefh ds initphysto'	
+
+	call histdef(fileid, 'frac_impa', ' ', ' ',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+	
+	call histdef(fileid, 'frac_nucl', ' ', ' ',
+     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
+     .             32, 'inst(X)', t_ops, t_wrt)
+
+c
+c pyu1
+c
+      CALL histdef(fileid, "pyu1", " ", " ",
+     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
+     .                "inst(X)", t_ops, t_wrt)
+
+c
+c pyv1
+c
+	CALL histdef(fileid, "pyv1", " ", " ",
+     .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,
+     .                "inst(X)", t_ops, t_wrt)
+	
+	write(*,*) 'apres pyv1 ds initphysto'
+c
+c ftsol1
+c
+	call histdef(fileid, "ftsol1", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1,1, -99,32,
+     .             "inst(X)", t_ops, t_wrt)
+
+c
+c ftsol2
+c
+        call histdef(fileid, "ftsol2", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1,1, -99,32,
+     .             "inst(X)", t_ops, t_wrt)
+
+c
+c ftsol3
+c
+        call histdef(fileid, "ftsol3", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
+     .             32, "inst(X)", t_ops, t_wrt)
+
+c
+c ftsol4
+c
+        call histdef(fileid, "ftsol4", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
+     .             32, "inst(X)", t_ops, t_wrt)
+	
+	
+c
+c psrf1
+c
+	call histdef(fileid, "psrf1", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
+     .             32, "inst(X)", t_ops, t_wrt)
+	
+c
+c psrf2
+c
+        call histdef(fileid, "psrf2", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
+     .             32, "inst(X)", t_ops, t_wrt)
+
+c
+c psrf3
+c
+        call histdef(fileid, "psrf3", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
+     .             32, "inst(X)", t_ops, t_wrt)
+
+c
+c psrf4
+c
+        call histdef(fileid, "psrf4", " ", " ",
+     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
+     .             32, "inst(X)", t_ops, t_wrt)
+	
+	write(*,*) 'avant histend ds initphysto'	
+
+      call histend(fileid)
+      if (ok_sync) call histsync(fileid)
+
+	
+
+      return
+      end
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/nuage.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/nuage.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/nuage.F	(revision 79)
@@ -37,6 +37,8 @@
       REAL zflwp, zradef, zfice, zmsac
 c
-      REAL radius, rad_froid, rad_chaud
-      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
+      REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2
+      PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
+ccc      PARAMETER (rad_chaud=15.0, rad_froid=35.0)
+c sintex initial      PARAMETER (rad_chaud=10.0, rad_froid=30.0)
       REAL coef, coef_froi, coef_chau
       PARAMETER (coef_chau=0.13, coef_froi=0.09)
@@ -51,4 +53,6 @@
       DO k = 1, klev
       DO i = 1, klon
+         rad_chaud = rad_chau1
+         IF (k.LE.3) rad_chaud = rad_chau2
          pclc(i,k) = MAX(pclc(i,k), seuil_neb)
          zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
@@ -127,5 +131,5 @@
       RETURN
       END
-      SUBROUTINE diagcld(paprs,pplay,t,q,rain,snow,kbot,ktop,
+      SUBROUTINE diagcld1(paprs,pplay,rain,snow,kbot,ktop,
      .                   diafra,dialiq)
       IMPLICIT none
@@ -155,11 +159,4 @@
       REAL diafra(klon,klev) ! fraction nuageuse diagnostiquee
       REAL dialiq(klon,klev) ! eau liquide nuageuse
-c
-c Options a choisir:
-      LOGICAL ok_conv ! prendre en compte les nuages convectifs
-      PARAMETER (ok_conv=.TRUE.)
-      LOGICAL ok_inve ! prendre en compte les nuages d'inversion
-CCC      PARAMETER (ok_inve=.TRUE.)
-      PARAMETER (ok_inve=.FALSE.)
 c
 c Constantes ajustables:
@@ -177,23 +174,8 @@
       REAL ZEPSCR
       PARAMETER (ZEPSCR=1.0E-10)
-      REAL CLOIA, CLOIB, CLOIC, CLOID
-ccc      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.6, CLOID=5.0)
-      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.9, CLOID=5.0)
-      REAL RGAMMAS
-      PARAMETER (RGAMMAS=0.05)
-      REAL CRHL
-ccc      PARAMETER (CRHL=0.15)
-      PARAMETER (CRHL=0.70)
-      REAL t_coup
-      PARAMETER (t_coup=234.0)
 c
 c Variables locales:
-      INTEGER i, k, kb, invb(klon)
-      REAL zcc(klon), zqs, zrhb, zcll, zdthmin(klon), zdthdp
-      REAL zdelta, zcor
-c
-c Fonctions thermodynamiques:
-#include "YOETHF.h"
-#include "FCTTRE.h"
+      INTEGER i, k
+      REAL zcc(klon)
 c
 c Initialisation:
@@ -205,6 +187,4 @@
       ENDDO
       ENDDO
-c
-      IF (ok_conv) THEN
 c
       DO i = 1, klon ! Calculer la fraction nuageuse
@@ -215,13 +195,11 @@
       ENDIF
       ENDDO
-cn
+c
       DO i = 1, klon ! pour traiter les enclumes
-         diafra(i,ktop(i)) = zcc(i) * CCFCT
-ccc      diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),zcc(i)*CCFCT)
+      diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),zcc(i)*CCFCT)
       IF ((zcc(i).GE.CANVH) .AND.
      .    (pplay(i,ktop(i)).LE.CETAHB*paprs(i,1)))
-     .   diafra(i,ktop(i)) = MAX(zcc(i)*CCFCT,CANVA*(zcc(i)-CANVB))      
-cc     . diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),
-cc     .                         MAX(zcc(i)*CCFCT,CANVA*(zcc(i)-CANVB)))
+     . diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),
+     .                         MAX(zcc(i)*CCFCT,CANVA*(zcc(i)-CANVB)))
       dialiq(i,ktop(i))=CCLWMR*diafra(i,ktop(i))
       ENDDO
@@ -230,6 +208,5 @@
       DO i = 1, klon
       IF (k.LT.ktop(i) .AND. k.GE.kbot(i)) THEN
-           diafra(i,k)=zcc(i)*CCFCT
-cc         diafra(i,k)=MAX(diafra(i,k),zcc(i)*CCFCT)
+         diafra(i,k)=MAX(diafra(i,k),zcc(i)*CCFCT)
          dialiq(i,k)=CCLWMR*diafra(i,k)
       ENDIF
@@ -237,8 +214,54 @@
       ENDDO
 c
-      ENDIF ! ok_conv
-c
-      IF (ok_inve) THEN
-
+      RETURN
+      END
+      SUBROUTINE diagcld2(paprs,pplay,t,q, diafra,dialiq)
+      IMPLICIT none
+c
+#include "dimensions.h"
+#include "dimphy.h"
+#include "YOMCST.h"
+c
+c Arguments d'entree:
+      REAL paprs(klon,klev+1) ! pression (Pa) a inter-couche
+      REAL pplay(klon,klev) ! pression (Pa) au milieu de couche
+      REAL t(klon,klev) ! temperature (K)
+      REAL q(klon,klev) ! humidite specifique (Kg/Kg)
+c
+c Arguments de sortie:
+      REAL diafra(klon,klev) ! fraction nuageuse diagnostiquee
+      REAL dialiq(klon,klev) ! eau liquide nuageuse
+c
+      REAL CETAMB
+      PARAMETER (CETAMB=0.80)
+      REAL CLOIA, CLOIB, CLOIC, CLOID
+      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.6, CLOID=5.0)
+ccc      PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.9, CLOID=5.0)
+      REAL RGAMMAS
+      PARAMETER (RGAMMAS=0.05)
+      REAL CRHL
+      PARAMETER (CRHL=0.15)
+ccc      PARAMETER (CRHL=0.70)
+      REAL t_coup
+      PARAMETER (t_coup=234.0)
+c
+c Variables locales:
+      INTEGER i, k, kb, invb(klon)
+      REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp
+      REAL zdelta, zcor
+c
+c Fonctions thermodynamiques:
+#include "YOETHF.h"
+#include "FCTTRE.h"
+c
+c Initialisation:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         diafra(i,k) = 0.0
+         dialiq(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
       DO i = 1, klon
          invb(i) = klev
@@ -280,11 +303,8 @@
      .   zcll=zcll*(1.-(CRHL-zrhb)*CLOID)
          zcll=MIN(1.0,MAX(0.0,zcll))
-cc         diafra(i,kb) = MAX(diafra(i,kb),zcll)
-cc         dialiq(i,kb)= diafra(i,kb) * RGAMMAS*zqs
-         diafra(i,kb) = zcll
-         dialiq(i,kb)= zcll* RGAMMAS*zqs        
-      ENDDO
-c
-      ENDIF ! ok_inve
-c
+         diafra(i,kb) = MAX(diafra(i,kb),zcll)
+         dialiq(i,kb)= diafra(i,kb) * RGAMMAS*zqs
+      ENDDO
+c
+      RETURN
       END
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/oasis.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F	(revision 79)
@@ -1,9 +1,2 @@
-      SUBROUTINE inicma(kastp,kexch,kstep)
-      IMPLICIT none
-c
-      INTEGER kastp, kexch, kstep
-c
-      INTEGER ime
-      PARAMETER (ime = 1)
 c
 C****
@@ -45,10 +38,14 @@
 C     -----------------------------------------------------------
 C
-      INTEGER imess(4)
-      INTEGER getpid, mknod ! system functions
-      CHARACTER*80 clcmd
-      CHARACTER*8 pipnom, fldnom
-      INTEGER ierror
-C
+      SUBROUTINE inicma(kastp,kexch,kstep)
+c
+      INTEGER kastp, kexch, kstep
+c
+      INTEGER ime
+      PARAMETER (ime = 1)
+
+      INTEGER iparal(3)
+      INTEGER ifcpl, idt, info, imxtag, istep
+c
 #include "dimensions.h"
 #include "dimphy.h"
@@ -56,11 +53,26 @@
 #include "clim.h"
 c
-      INTEGER iparal(3)
-      INTEGER istep, ifcpl, idt, info, imxtag
-c
-      INTEGER mode, iret, isize
+c     Addition for SIPC CASE
+#include "param_sipc.h"
+#include "param_cou.h"
+#include "inc_sipc.h"
+#include "inc_cpl.h"
+      CHARACTER*9 clpoolnam 
+      INTEGER ipoolhandle, imrc, ipoolsize, index, jf
+      CHARACTER*3 cljobnam      ! experiment name
+      CHARACTER*6 clmodnam      ! model name
+      CHARACTER*5 cloasis       ! coupler name (Oasis)
+      INTEGER imess(4), imesso(4)
+      INTEGER getpid, mknod ! system functions
+      CHARACTER*80 clcmd
+      CHARACTER*8 pipnom, fldnom
+      INTEGER ierror, iretcode
 C
       INTEGER nuout
       PARAMETER (nuout = 6)
+c
+C
+c
+
 C     -----------------------------------------------------------
 C
@@ -75,765 +87,421 @@
       WRITE(nuout,*) ' '
 c
-      IF (cchain.EQ."PIPE") THEN
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Making pipes for fields to receive from CPL"
-      WRITE(nuout,*) " "
-c
-c zxli(le17fev97): je ne comprends pas pourquoi il faut
-c                  avoir 2 noms pour un seul pipe
-c
-      pipnom = "SISUTESU"
-      fldnom = "Sisutesu"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "SIALBEDO"
-      fldnom = "Sialbedo"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "SIICECOV"
-      fldnom = "Siicecov"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "SIICEALB"
-      fldnom = "Siicealb"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Making pipes for fields to send to CPL"
-      WRITE(nuout,*) " "
-c
-      pipnom = "CONSFTOT"
-      fldnom = "Consftot"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COSSTSST"
-      fldnom = "Cosstsst"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "CODFLXDT"
-      fldnom = "Codflxdt"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COSHFTOT"
-      fldnom = "Coshftot"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COALBSUR"
-      fldnom = "Coalbsur"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COTOSPSU"
-      fldnom = "Cotospsu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COTOLPSU"
-      fldnom = "Cotolpsu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COTFSHSU"
-      fldnom = "Cotfshsu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "CORUNCOA"
-      fldnom = "Coruncoa"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "CORIVFLU"
-      fldnom = "Corivflu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COZOTAUX"
-      fldnom = "Cozotaux"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COMETAUY"
-      fldnom = "Cometauy"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COZOTAU2"
-      fldnom = "Cozotau2"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COMETAU2"
-      fldnom = "Cometau2"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "All pipes have been made"
-      WRITE(nuout,*) " "
-      CALL flush(nuout)
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Communication test between ATM and CPL"
-      WRITE(nuout,*) " "
-c
-      WRITE (pipnom,'(a6,i2.2)') "Preadm", ime
-#ifdef CRAY
-      clcmd = "assign -s u f:"//pipnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-#endif
-      WRITE(nuout,'(a80)') clcmd
+c     1.2.1-Define the model name
+c
+      clmodnam = 'lmd.xx'       ! as $NBMODEL in namcouple
+c
+c     1.2.2-Define the coupler name
+c
+      cloasis = 'Oasis'        !  as in coupler
+c
+c
+c     1.3.1-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)='CONSFTOT'
+      cl_writ(2)='COSHFTOT'
+      cl_writ(3)='COTOPRSU'
+      cl_writ(4)='COTFSHSU'
+      cl_writ(5)='CORUNCOA'
+      cl_writ(6)='CORIVFLU'
+      cl_writ(7)='COZOTAUX'
+      cl_writ(8)='COZOTAU2'
+      cl_writ(9)='COMETAUY'
+      cl_writ(10)='COMETAU2'
+c
+c     1.3.2-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)='atmflx'
+      cl_f_writ(2)='atmflx'
+      cl_f_writ(3)='atmflx'
+      cl_f_writ(4)='atmflx'
+      cl_f_writ(5)='atmflx'
+      cl_f_writ(6)='atmflx'
+      cl_f_writ(7)='atmtau'
+      cl_f_writ(8)='atmtau'
+      cl_f_writ(9)='atmtau'
+      cl_f_writ(10)='atmtau'
+c
+c
+c     1.4.1-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)='SISUTESU'
+      cl_read(2)='SIICECOV'
+c
+c     1.4.2-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)='atmsst'
+      cl_f_read(2)='atmice'
+c
+c     1.5-Define infos for sending to oasis
+c
       imess(1) = kastp
       imess(2) = kexch
       imess(3) = kstep
       imess(4) = getpid()
-#ifdef CRAY
-      WRITE (pipnom) imess ! send message to pipe
-#else
-      iret=0
-      isize=4
-      CALL pipwrite(pipnom, imess, isize, iret)
-#endif
-      WRITE(nuout,*) "Msg sent to pipe "//pipnom
-      CALL flush(nuout)
-c
-      WRITE (pipnom,'(a6,i2.2)') "Pwritm", ime
-#ifdef CRAY
-      clcmd = "assign -s unblocked f:"//pipnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-#endif
-      WRITE(nuout,'(a80)') clcmd
-c
-      WRITE(nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush(nuout)
-#ifdef CRAY
-      READ (pipnom) imess ! read message from pipe
-#else
-      isize=1
-      iret =0
-      CALL pipread(pipnom,imess,isize,iret)
-#endif
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Communication test between ATM and CPL is OK"
-      WRITE(nuout,*) " total simulation time in oasis = ", imess(1)
-      WRITE(nuout,*) " total number of iterations is  = ", imess(2)
-      WRITE(nuout,*) " value of oasis timestep  is    = ", imess(3)
-      WRITE(nuout,*) " process id for oasis  is       = ", imess(4)
-      WRITE(nuout,*) " "
-      CALL flush(nuout)
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-      CALL CLIM_Init ( 'CLI', 'lmd.xx', 3, 7,
+
+c
+c
+      IF (cchan.eq.'PIPE') THEN 
+c
+          ierror=0
+c
+c
+          WRITE(nuout,*) ' '
+          WRITE(nuout,*) 'Making pipes for fields to receive from CPL'
+          WRITE(nuout,*) ' '
+c
+c loop to define pipes (ocean=CPL to atmos)
+c
+          DO jf=1, jpfldo2a
+            CALL PIPE_Model_Define(nuout, cl_read(jf), jpread, iretcode)
+            IF (iretcode.ne.0) ierror=ierror+1
+          END DO 
+c
+          WRITE(nuout,*) ' '
+          WRITE(nuout,*) 'Making pipes for fields to send to CPL'
+          WRITE(nuout,*) ' '
+c
+c loop to define pipes (atmos to ocean=CPL)
+c
+          DO jf=1, jpflda2o
+            CALL PIPE_Model_Define(nuout, cl_writ(jf), jpwrit, iretcode)
+            IF (iretcode.ne.0) ierror=ierror+1
+          END DO 
+c
+          IF (ierror.ne.0) THEN
+              WRITE (nuout,*) 'Error in pipes definitions'
+              WRITE (nuout,*) 'STOP inicma'
+              CALL abort
+          END IF 
+c
+          WRITE(nuout,*) ' '
+          WRITE(nuout,*) 'All pipes have been made'
+          WRITE(nuout,*) ' '
+c
+          WRITE(nuout,*) ' '
+          WRITE(nuout,*) 'Communication test between ATM and CPL'
+          WRITE(nuout,*) ' '
+          CALL flush(nuout)
+c
+          CALL PIPE_Model_Stepi(nuout, imess, ime, imesso, ierror)
+c
+          IF (ierror.ne.0) THEN
+              WRITE (nuout,*)
+     $            'Error in exchange first informations with Oasis' 
+              WRITE (nuout,*) 'STOP inicma'
+              CALL abort
+          END IF 
+c
+          WRITE(nuout,*) ' '
+          WRITE(nuout,*) 'Communication test between ATM and CPL is OK'
+          WRITE(nuout,*) ' total simulation time in oasis = ', imesso(1)
+          WRITE(nuout,*) ' total number of iterations is  = ', imesso(2)
+          WRITE(nuout,*) ' value of oasis timestep  is    = ', imesso(3)
+          WRITE(nuout,*) ' process id for oasis  is       = ', imesso(4)
+          WRITE(nuout,*) ' '
+          CALL flush(nuout)
+c
+      ELSE  IF (cchan.eq.'SIPC') THEN
+c
+c debug for more information
+c
+c          CALL SVIPC_debug(1)
+c  
+c
+c     1.1-Define the experiment name :
+c
+          cljobnam = 'IPC'      ! as $JOBNAM in namcouple
+c
+c         3-Attach to shared memory pool used to exchange initial infos 
+c
+          imrc = 0
+          CALL SIPC_Init_Model (cljobnam, clmodnam, 1, imrc)
+          IF (imrc .NE. 0) THEN 
+            WRITE (nuout,*)'   '
+            WRITE (nuout,*)'WARNING: Problem with attachement to', imrc 
+            WRITE (nuout,*)'         initial memory pool(s) in atmos'
+            WRITE (nuout,*)'   '
+            CALL ABORT('STOP in atmos')
+          ENDIF
+c
+c         4-Attach to pools used to exchange fields from atmos to coupler
+c
+ 	  DO jf = 1, jpflda2o
+c
+C
+c           Pool name:
+            clpoolnam = 'P'//cl_writ(jf)
+C
+            CALL SIPC_Attach(clpoolnam, ipoolhandle)
+c     
+c           Resulting pool handle:
+            mpoolwrit(jf) = ipoolhandle  
+C
+            END DO 
+C
+c         5-Attach to pools used to exchange fields from coupler to atmos
+c
+          DO jf = 1, jpfldo2a
+c
+c           Pool name:
+            clpoolnam = 'P'//cl_read(jf)
+c
+            CALL SIPC_Attach(clpoolnam, ipoolhandle)
+c
+c           Resulting pool handle:
+            mpoolread(jf) = ipoolhandle  
+c
+          END DO 
+c
+c         6-Exchange of initial infos
+c
+c         Write data array isend to pool READ by Oasis
+c
+          imrc = 0
+          ipoolsize = 4*jpbyteint
+          CALL SVIPC_Write(mpoolinitr, imess, ipoolsize, imrc)
+C
+C         Find error if any
+C
+          IF (imrc .LT. 0) THEN
+              WRITE (nuout,*) '   '
+              WRITE (nuout,*) 'Problem in atmos in writing initial' 
+              WRITE (nuout,*) 'infos to the shared memory segment(s)'
+              WRITE (nuout,*) '   '
+          ELSE
+              WRITE (nuout,*) '   '
+              WRITE (nuout,*) 'Initial infos written in atmos'            
+              WRITE (nuout,*) 'to the shared memory segment(s)'
+              WRITE (nuout,*) '   '
+          ENDIF
+C
+C         Read data array irecv from pool written by Oasis
+C
+          imrc = 0
+          ipoolsize = 4*jpbyteint
+          CALL SVIPC_Read(mpoolinitw, imesso, ipoolsize, imrc)
+C
+C*        Find error if any
+C
+          IF (imrc .LT. 0) THEN
+              WRITE (nuout,*) '   '
+              WRITE (nuout,*) 'Problem in atmos in reading initial' 
+              WRITE (nuout,*) 'infos from the shared memory segment(s)'
+              WRITE (nuout,*) '   '
+          ELSE
+              WRITE (nuout,*) '   '
+              WRITE (nuout,*) 'Initial infos read by atmos'                
+              WRITE (nuout,*) 'from the shared memory segment(s)'
+              WRITE (nuout,*) '   '
+              WRITE(*,*) ' ntime, niter, nstep, Oasis pid:'
+              WRITE(*,*) imesso(1), imesso(2), imesso(3), imesso(4) 
+          ENDIF
+C
+C         Detach from shared memory segment(s)
+C
+          imrc = 0
+          CALL SVIPC_close(mpoolinitw, 0, imrc)
+C
+C         Find error if any
+C
+          IF (imrc .LT. 0) THEN
+              WRITE (nuout,*) 
+     $          'Problem in detaching from shared memory segment(s)'
+              WRITE (nuout,*)
+     $          'used by atmos to read initial infos' 
+          ENDIF
+c
+c
+      ELSE IF (cchan.eq.'CLIM') THEN
+
+c
+c     1.1-Define the experiment name :
+c
+          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
+
+          OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown',
+     $          FORM = 'formatted')
+          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
      *                 kastp, kexch, kstep,
-     *                 5, 1200, 300, info )
-      IF (info.EQ.CLIM_Ok) THEN
-         WRITE(nuout,*) "inicma: CLIM_Init OK"
-      ELSE
-         WRITE(nuout,*) "inicma: CLIM_Init erreur:", info
-         CALL ABORT("STOP in inicma")
-      ENDIF
-c
-      iparal ( CLIM_Strategy ) = CLIM_Serial
-      iparal ( CLIM_Length   ) = iim*(jjm+1)
-      iparal ( CLIM_Offset   ) = 0
-c
-      CALL CLIM_Define ('SISUTESU', CLIM_In , CLIM_Double, iparal, info)
-      CALL CLIM_Define ('SIALBEDO', CLIM_In , CLIM_Double, iparal, info)
-      CALL CLIM_Define ('SIICECOV', CLIM_In , CLIM_Double, iparal, info)
-      CALL CLIM_Define ('SIICEALB', CLIM_In , CLIM_Double, iparal, info)
-c
-      CALL CLIM_Define ('CONSFTOT', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COSSTSST', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('CODFLXDT', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COSHFTOT', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COALBSUR', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COTOSPSU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COTOLPSU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COTFSHSU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('CORUNCOA', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('CORIVFLU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COZOTAUX', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COMETAUY', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COZOTAU2', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COMETAU2', CLIM_Out , CLIM_Double, iparal,info)
-      WRITE(nuout,*) 'inicma : CLIM_Define ok '
-c
-      CALL CLIM_Start ( imxtag, info )
-      IF (info.NE.CLIM_Ok) THEN
-          WRITE (nuout,*) "inicma: CLIM_Start pb. ", info
-          CALL ABORT("STOP in inicma")
-      ELSE
-          WRITE (nuout,*)  "inicma: CLIM_Start OK"
-      ENDIF
-c
-      CALL CLIM_Stepi ("oasis", istep, ifcpl, idt, info)
-      IF (info .NE. CLIM_Ok) THEN
-          WRITE (nuout,*) "inicma: CLIM_Stepi pb. ", info
-          CALL ABORT("STOP in inicma")
-      ELSE
-          WRITE (nuout,*) "inicma: CLIM_Stepi OK"
-          WRITE (nuout,*) " number of tstep in oasis ", istep
-          WRITE (nuout,*) " exchange frequency in oasis ", ifcpl
-          WRITE (nuout,*) " length of tstep in oasis ", idt
-      ENDIF
-c
-      ENDIF
-c
+     *                 5, 3600, 3600, info )
+c
+          IF (info.ne.clim_ok) THEN
+              WRITE ( nuout, *) ' inicma : pb init clim '
+              WRITE ( nuout, *) ' error code is = ', info
+              CALL abort('STOP in inicma')
+            ELSE
+              WRITE(nuout,*) 'inicma : init clim ok '
+          ENDIF
+c
+          iparal ( clim_strategy ) = clim_serial
+          iparal ( clim_length   ) = iim*(jjm+1)
+          iparal ( clim_offset   ) = 0
+c
+c loop to define messages (CPL=ocean to atmos)
+c
+          DO jf=1, jpfldo2a
+            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
+     $          , info )  
+          END DO 
+
+c
+c loop to define messages (atmos to ocean=CPL)
+c
+          DO jf=1, jpflda2o
+            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
+     $          iparal, info )   
+          END DO 
+
+          WRITE(nuout,*) 'inicma : clim_define ok '
+          CALL CLIM_Start ( imxtag, info )
+          IF (info.ne.clim_ok) THEN
+              WRITE ( nuout, *) 'inicma : pb start clim '
+              WRITE ( nuout, *) ' error code is = ', info
+              CALL abort('stop in inicma')
+            ELSE
+              WRITE ( nuout, *)  'inicma : start clim ok '
+          ENDIF
+c
+          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
-      SUBROUTINE fromcpl(jour, imjm, sst, sic, alb_sst, alb_sic)
+
+      SUBROUTINE fromcpl(kt, imjm, sst, gla)
       IMPLICIT none
 c
 c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
 c provided by the coupler. Of course, it waits until it receives
-c the signal from the corresponding pipes in the case of utilizing
-c the pipe technique.
-c
-      INTEGER imjm, jour
-      REAL sst(imjm)      ! sea surface temperature
-      REAL alb_sst(imjm)  ! open sea albedo
-      REAL sic(imjm)      ! sea ice cover
-      REAL alb_sic(imjm)  ! sea ice albedo
-c
-      INTEGER nuout   ! listing output unit
+c the signal from the corresponding pipes.
+c 3 techniques:
+c  - pipes and signals (only on Cray C90 and Cray J90)
+c  - CLIM (PVM exchange messages)
+c  - SVIPC shared memory segments and semaphores
+c
+      INTEGER imjm, kt
+      REAL sst(imjm)          ! sea-surface-temperature
+      REAL gla(imjm)          ! sea-ice
+c
+      INTEGER nuout             ! listing output unit
       PARAMETER (nuout=6)
 c
       INTEGER nuread, ios, iflag, icpliter
-      CHARACTER*8 pipnom ! name for the pipe
-      CHARACTER*8 fldnom ! name for the field
-      CHARACTER*8 filnom ! name for the data file
+      CHARACTER*8 pipnom        ! name for the pipe
+      CHARACTER*8 fldnom        ! name for the field
+      CHARACTER*8 filnom        ! name for the data file
+
+      INTEGER info, jf
+
 c
 #include "oasis.h"
 #include "clim.h"
-      INTEGER info, jktm1
-      INTEGER iret, isize
-c
-      WRITE (nuout,*) " "
-      WRITE (nuout,*) "Fromcpl: Read fields from CPL"
-      WRITE (nuout,*) " "
+c
+#include "param_cou.h"
+c
+#include "inc_sipc.h"
+#include "inc_cpl.h"
+c
+c     Addition for SIPC CASE
+      INTEGER index
+      CHARACTER*3 cmodinf       ! Header or not
+      CHARACTER*3 cljobnam_r    ! Experiment name in the field brick, if any 
+      INTEGER infos(3)          ! infos in the field brick, if any
+c
+c
+      WRITE (nuout,*) ' '
+      WRITE (nuout,*) 'Fromcpl: Read fields from CPL, kt=',kt
+      WRITE (nuout,*) ' '
       CALL flush (nuout)
-c
-      IF (cchain.EQ."PIPE") THEN
-c
-c sea-surface-temperature:
-c
-      pipnom = "Sisutesu"
-      fldnom = "SISUTESU"
-      filnom = "atmsst"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, sst, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-c open sea albedo:
-c
-      pipnom = "Sialbedo"
-      fldnom = "SIALBEDO"
-      filnom = "atmice"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, alb_sst, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-c sea-ice cover:
-c
-      pipnom = "Siicecov"
-      fldnom = "SIICECOV"
-      filnom = "atmice"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, sic, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-c sea-ice albedo:
-c
-      pipnom = "Siicealb"
-      fldnom = "SIICEALB"
-      filnom = "atmice"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, alb_sic, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-      jktm1=jour-1
-c
-      CALL CLIM_Import ('SISUTESU', jktm1, sst, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SISUTESU'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      CALL CLIM_Import ('SIALBEDO', jktm1, alb_sst, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SIALBEDO'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      CALL CLIM_Import ('SIICECOV', jktm1, sic, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SIICECOV'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      CALL CLIM_Import ('SIICEALB', jktm1, alb_sic, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SIICEALB'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      ENDIF ! fin de test sur cchain
+
+      IF (cchan.eq.'PIPE') THEN 
+c
+c UNIT number for fields
+c
+          nuread = 99
+c
+c exchanges from ocean=CPL to atmosphere
+c
+          DO jf=1,jpfldo2a
+            CALL PIPE_Model_Recv(cl_read(jf), icpliter, nuout)
+            OPEN (nuread, FILE=cl_f_read(jf), FORM='UNFORMATTED')
+            IF (jf.eq.1)
+     $          CALL locread(cl_read(jf), sst, imjm, nuread, iflag,
+     $          nuout)
+            IF (jf.eq.2)
+     $          CALL locread(cl_read(jf), gla, imjm, nuread, iflag,
+     $          nuout)
+            CLOSE (nuread)
+          END DO 
+
+c
+      ELSE IF (cchan.eq.'SIPC') THEN 
+c
+c         Define IF a header must be encapsulated within the field brick :
+          cmodinf = 'NOT'                 ! as $MODINFO in namcouple  
+c 
+c         reading of input field sea-surface-temperature SISUTESU
+c
+c
+c         Index of sst in total number of fields jpfldo2a: 
+          index = 1
+c
+          CALL SIPC_Read_Model(index, imjm, cmodinf, 
+     $              cljobnam_r,infos, sst)
+c
+c         reading of input field sea-ice SIICECOV
+c
+c
+c         Index of sea-ice in total number of fields jpfldo2a: 
+          index = 2
+c
+          CALL SIPC_Read_Model(index, imjm, cmodinf, 
+     $              cljobnam_r,infos, gla)
+c
+c
+      ELSE IF (cchan.eq.'CLIM') THEN 
+
+c
+c exchanges from ocean=CPL to atmosphere
+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 ( 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
+                WRITE(nuout,*)'STOP in Fromcpl'
+                STOP 'Fromcpl'
+            ENDIF
+          END DO 
+
+      ENDIF 
 c
       RETURN
       END
 
-      SUBROUTINE locread (cdfldn, pfield, kdimax, knulre, kflgre)
-      IMPLICIT none
-      INTEGER kdimax, knulre, kflgre
-C****
-C               *****************************
-C               * OASIS ROUTINE  -  LEVEL 0 *
-C               * -------------     ------- *
-C               *****************************
-C
-C**** *locread*  - Read binary field on unit knulre
-C
-C     Purpose:
-C     -------
-C     Find string cdfldn on unit knulre and read array pfield
-C
-C**   Interface:
-C     ---------
-C       *CALL*  *locread (cdfldn, pfield, kdimax, knulre, kflgre)*
-C
-C     Input:
-C     -----
-C                cdfldn : character string locator
-C                kdimax : dimension of field to be read 
-C                knulre : logical unit to be read 
-C
-C     Output:
-C     ------
-C                pfield : field array (real 1D)
-C                kflgre : error status flag
-C
-C     Workspace:
-C     ---------
-C     None
-C
-C     Externals:
-C     ---------
-C     None
-C
-C     Reference:
-C     ---------
-C     See OASIS manual (1995) 
-C
-C     History:
-C     -------
-C       Version   Programmer     Date      Description
-C       -------   ----------     ----      -----------  
-C       2.0       L. Terray      95/09/01  created
-C
-C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-C
-C* ---------------------------- Include files ---------------------------
-C
-C
-C* ---------------------------- Argument declarations -------------------
-C
-      REAL pfield(kdimax)
-      CHARACTER*8 cdfldn
-C
-C* ---------------------------- Local declarations ----------------------
-C
-      CHARACTER*8 clecfl
-      INTEGER nulou
-c
-      nulou = 6
-C
-C* ---------------------------- Poema verses ----------------------------
-C
-C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-C
-C*    1. Initialization
-C        --------------
-C
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     WRITE (UNIT = nulou,FMT = *) 
-c    $    '           ROUTINE locread  -  Level 0'
-c     WRITE (UNIT = nulou,FMT = *) 
-c    $    '           ***************     *******'
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     WRITE (UNIT = nulou,FMT = 1001) knulre
-c     WRITE (UNIT = nulou,FMT = *) ' '
-C
-C* Formats
-C
- 1001 FORMAT(5X,' Read binary file connected to unit = ',I3)
-C
-C     2. Find field in file
-C        ------------------
-C
-      REWIND knulre
- 200  CONTINUE
-C* Find string
-      READ (UNIT = knulre, ERR = 210, END = 210) clecfl
-      IF (clecfl .NE. cdfldn) GO TO  200
-C* Read associated field
-      READ (UNIT = knulre, ERR = 210, END = 210) pfield
-C* Reading done and ok
-      kflgre = 0
-      GO TO 220
-C* Problem in reading
- 210  kflgre = 1
- 220  CONTINUE
-C
-C
-C*    3. End of routine
-C        --------------
-C
-c     WRITE (UNIT = nulou,FMT = *) 
-c    $    '          --------- End of routine locread ---------'
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     CALL FLUSH (nulou)
-      RETURN
-      END
-
-
-      SUBROUTINE intocpl(itau,imjm,
+
+      SUBROUTINE intocpl(kt,imjm,
      .                   fsol, fnsol,
      .                   rain, snow, evap, ruisoce, ruisriv,
-     .                   tsol, fder, albe,
-     .                   taux, tauy)
+     .                   taux, tauy, last)
       IMPLICIT NONE
 c
@@ -841,6 +509,12 @@
 c coupler. Of course, it sends a message to the corresponding pipes
 c after the writting.
-c
-      INTEGER itau, imjm
+c 3 techniques : pipes
+c                clim
+c                svipc
+c IF last time step WRITE output files anway
+c
+#include "oasis.h"
+
+      INTEGER kt, imjm
 c
       REAL fsol(imjm)
@@ -851,458 +525,321 @@
       REAL ruisoce(imjm)
       REAL ruisriv(imjm)
-      REAL tsol(imjm)
-      REAL fder(imjm)
-      REAL albe(imjm)
       REAL taux(imjm)
       REAL tauy(imjm)
+      LOGICAL last
 c
       INTEGER nuout
       PARAMETER (nuout = 6)
+c
+c Additions for SVIPC
+c
+      INTEGER index
+      INTEGER infos(3)
+      CHARACTER*3 cmodinf       ! Header or not
+      CHARACTER*3 cljobnam      ! experiment name
+c
+#include "clim.h"
+c
+#include "param_cou.h"
+c
+#include "inc_sipc.h"
+#include "inc_cpl.h"
+c
 C
       INTEGER nuwrit, ios
       CHARACTER*8 pipnom
       CHARACTER*8 fldnom
-      CHARACTER*8 filnom
-c
-c
-#include "oasis.h"
-#include "clim.h"
-      INTEGER info
-      INTEGER isize, iret
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Intocpl: send fields to CPL, itau= ", itau
-      WRITE(nuout,*) " "
-c
-      IF (cchain.EQ."PIPE") THEN
-c
-      nuwrit = 99
-      filnom = "atmflx"
-      OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(6,*) "Error while connecting "//filnom
-          CALL ABORT('STOP in intocpl')
-      ENDIF
-      REWIND ( UNIT = nuwrit)
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
-      WRITE(nuout,*) " "
-      CALL flush(nuout)
-C
-C            ecriture CONSFTOT (flux non solaire)
-C
-      fldnom = "CONSFTOT"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) fnsol
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COSHFTOT (solaire)
-C
-      fldnom = "COSHFTOT"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) fsol
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COTOLPSU (precipitation liquide)
-C
-      fldnom = "COTOLPSU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) rain
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COTOSPSU (precipitation solide)
-C
-      fldnom = "COTOSPSU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) snow
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COTFSHSU (evaporation)
-C
-      fldnom = "COTFSHSU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) evap
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COSSTSST (temperature du sol)
-C
-      fldnom = "COSSTSST"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) tsol
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture CODFLXDT (derivee du flux non-solaire)
-C
-      fldnom = "CODFLXDT"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) fder
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COALBSUR (albedo moyen)
-C
-      fldnom = "COALBSUR"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) albe
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture CORUNCOA (runoff DIRECT)
-C
-      fldnom = "CORUNCOA"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) ruisoce
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture river runoff 'CORIVFLU'
-C
-      fldnom = "CORIVFLU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) ruisriv
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      CLOSE(UNIT = nuwrit)
+      CHARACTER*6 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
+c
+      icstep=kt 
+c
+      WRITE(nuout,*) ' '
+      WRITE(nuout,*) 'Intocpl: send fields to CPL, kt= ', kt
+      WRITE(nuout,*) ' '
+
+      IF (last.or.(cchan.eq.'PIPE')) THEN 
+c
+c
+c WRITE fields for coupler with pipe technique or for last time step
+c
+c         initialisation
+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, jpflda2o
+            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 
+          
+          DO jn=1, max_file 
+            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
+          END DO 
+          
+          DO jf=1, jpflda2o
+            IF (jf.eq.1)
+     $          CALL locwrite(cl_writ(jf),fnsol, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.2)
+     $          CALL locwrite(cl_writ(jf),fsol, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.3)
+     $          CALL locwrite(cl_writ(jf),rain, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.4)
+     $          CALL locwrite(cl_writ(jf),evap, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.5)
+     $          CALL locwrite(cl_writ(jf),ruisoce, imjm,
+     $          file_unit_field(jf),ierror, nuout) 
+            IF (jf.eq.6)
+     $          CALL locwrite(cl_writ(jf),ruisriv, imjm,
+     $          file_unit_field(jf),ierror, nuout) 
+            IF (jf.eq.7)
+     $          CALL locwrite(cl_writ(jf),taux, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.8)
+     $          CALL locwrite(cl_writ(jf),taux, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.9)
+     $          CALL locwrite(cl_writ(jf),tauy, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.10)
+     $          CALL locwrite(cl_writ(jf),tauy, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+          END DO 
 C
 C simulate a FLUSH
 C
-      OPEN(nuwrit, FILE=filnom, FORM='unformatted')
-      CLOSE(UNIT = nuwrit)
-C
-C Send message to pipes:
-c
-      pipnom = 'Consftot'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Coshftot'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cotolpsu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cotospsu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cotfshsu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cosstsst'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Codflxdt'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Coalbsur'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Coruncoa'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Corivflu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-C
-C Send wind stresses to coupler
-c
-      nuwrit = 99
-      filnom = "atmtau"
-      OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(6,*) "Error while connecting "//filnom
-          CALL ABORT('STOP in intocpl')
-      ENDIF
-      REWIND ( UNIT = nuwrit)
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
-      WRITE(nuout,*) " "
-C
-C ecriture COZOTAUX
-c
-      fldnom = "COZOTAUX"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) taux
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      fldnom = "COZOTAU2"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) taux
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C ecriture COMETAUY
-C
-      fldnom = "COMETAUY"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) tauy
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      fldnom = "COMETAU2"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) tauy
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      CLOSE(UNIT = nuwrit)
-C
-C simulate a FLUSH
-C
-      OPEN(nuwrit, FILE=filnom, FORM='unformatted')
-      CLOSE(UNIT = nuwrit)
-c
-c Send message to pipes:
-c
-      pipnom = 'Cozotaux'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cozotau2'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cometauy'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cometau2'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-      CALL CLIM_Export("CONSFTOT", itau, fnsol, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fnsol pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COSHFTOT", itau, fsol, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fsol pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COTOLPSU", itau, rain, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export rain pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COTOSPSU", itau, snow, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export snow pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COTFSHSU", itau, evap, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export evap pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COSSTSST", itau, tsol, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export tsol pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("CODFLXDT", itau, fder, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COALBSUR", itau, albe, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("CORUNCOA", itau, ruisoce, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export ruisoce pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("CORIVFLU", itau, ruisriv, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export ruisriv pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COZOTAUX", itau, taux, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COZOTAU2", itau, taux, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COMETAUY", itau, tauy, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COMETAU2", itau, tauy, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      ENDIF
+          DO jn=1, max_file 
+            CLOSE (file_unit(jn))
+          END DO 
+c
+c 
+c
+          IF(cchan.eq.'CLIM') THEN 
+c
+c inform PVM daemon, I have 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 
+          
+      END IF 
+      
+c
+c IF last we have finished
+c
+      IF (last) RETURN 
+      
+      IF (cchan.eq.'PIPE') THEN 
+c
+c Send message to pipes for CPL=ocean
+c
+          DO jf=1, jpflda2o
+            CALL PIPE_Model_Send(cl_writ(jf), kt, nuout)
+          END DO 
+c
+c 
+c
+      ELSE  IF(cchan.eq.'SIPC') THEN 
+c
+c         Define IF a header must be encapsulated within the field brick :
+          cmodinf = 'NOT'                 ! as $MODINFO in namcouple  
+c
+c         IF cmodinf = 'YES', define encapsulated infos to be exchanged
+c		  infos(1) = initial date
+c		  infos(2) = timestep
+c		  infos(3) = actual time
+c
+c         Writing of output field non solar heat flux CONSFTOT
+c
+c         Index of non solar heat flux in total number of fields jpflda2o: 
+          index = 1
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos,fnsol)
+c
+c
+c         Writing of output field solar heat flux COSHFTOT
+c
+c         Index of solar heat flux in total number of fields jpflda2o: 
+          index = 2
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos,fsol)
+c
+c         Writing of output field rain COTOPRSU
+c
+c         Index of rain in total number of fields jpflda2o: 
+          index = 3
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, rain)
+c
+c         Writing of output field evap COTFSHSU
+c
+c         Index of evap in total number of fields jpflda2o: 
+          index = 4
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, evap)
+c
+c         Writing of output field ruisoce CORUNCOA
+c
+c         Index of ruisoce in total number of fields jpflda2o: 
+          index = 5
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, ruisoce)
+c
+c
+c         Writing of output field ruisriv CORIVFLU
+c
+c         Index of ruisriv in total number of fields jpflda2o: 
+          index = 6
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, ruisriv)
+c
+c
+c         Writing of output field zonal wind stress COZOTAUX
+c
+c         Index of runoff in total number of fields jpflda2o: 
+          index = 7
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, taux)
+c
+c         Writing of output field meridional wind stress COMETAUY
+c
+c         Index of runoff in total number of fields jpflda2o: 
+          index = 8
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, taux)
+c
+c
+c         Writing of output field zonal wind stress COMETAU2 (at v point)
+c
+c         Index of runoff in total number of fields jpflda2o: 
+          index = 9
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, tauy)
+c
+c         Writing of output field meridional wind stress COMETAU2
+c
+c         Index of runoff in total number of fields jpflda2o: 
+          index = 10
+c   
+          CALL SIPC_Write_Model(index, imjm, cmodinf,
+     $                          cljobnam,infos, tauy)
+c
+c
+      ELSE IF(cchan.eq.'CLIM') THEN 
+          
+          DO jn=1, jpflda2o
+            
+            IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fnsol, info)
+            IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsol, info)
+            IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, rain, info)
+            IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, evap, info)
+            IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, ruisoce, info
+     $          )
+            IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ruisriv, info
+     $          )
+            IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
+            IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
+            IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
+            IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, tauy, 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
+                WRITE (nuout,*) 'STOP in intocpl '
+                CALL abort(' intocpl ')
+            ENDIF
+            
+          END DO 
+          
+      ENDIF 
 c
       RETURN
       END
-      SUBROUTINE quitcpl
-      IMPLICIT none
-c
-c Sortir du coupleur
-c
-      INTEGER nuout   ! listing output unit
-      PARAMETER (nuout=6)
-c
-#include "oasis.h"
-#include "clim.h"
-      INTEGER info
-c
-      IF (cchain.EQ."PIPE") THEN
-c
-         WRITE(nuout,*)"On sort du coupleur sans rien faire"
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-         CALL CLIM_Quit(CLIM_StopPvm,info)
-         IF (info.NE.CLIM_Ok) THEN
-            WRITE(nuout,*)"Erreur pour quiter coupleur:",info
-         ENDIF
-c
-      ENDIF
-c
+
+      SUBROUTINE locread
+      print *, 'Attention dans oasis.F, locread est non defini'
       RETURN
       END
 
-
-      SUBROUTINE makepipe
-      PRINT*, "rien"
+      SUBROUTINE locwrite
+      print *, 'Attention dans oasis.F, locwrite est non defini'
+      RETURN
       END
-      SUBROUTINE pipwrite
-      PRINT*, "rien"
+
+      SUBROUTINE pipe_model_define
+      print*,'Attention dans oasis.F, pipe_model_define est non defini'
+      RETURN
       END
-      SUBROUTINE pipread
-      PRINT*, "rien"
+
+      SUBROUTINE pipe_model_stepi
+      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
+      RETURN
       END
-      SUBROUTINE CLIM_Init
-      PRINT*, "rien"
+
+      SUBROUTINE pipe_model_recv
+      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
+      RETURN
       END
-      SUBROUTINE CLIM_Define
-      PRINT*, "rien"
+
+      SUBROUTINE pipe_model_send
+      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
+      RETURN
       END
-      SUBROUTINE CLIM_Start
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Stepi
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Import
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Export
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_quit
-      PRINT*, "rien"
-      END
+
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.h
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/oasis.h	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.h	(revision 79)
@@ -2,5 +2,8 @@
       PARAMETER (ok_oasis = .FALSE.)
 c
-      CHARACTER*8 cchain
-      PARAMETER (cchain="PIPE")
-c      PARAMETER (cchain="CLIM")
+      CHARACTER*4 cchan
+      PARAMETER (cchan="PIPE")
+c      PARAMETER (cchan="CLIM")
+
+      INTEGER jpmaxfld
+      PARAMETER(jpmaxfld = 20)
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/param_cou.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/param_cou.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/param_cou.h	(revision 79)
@@ -0,0 +1,11 @@
+C
+C -- param_cou.h
+C
+	INTEGER jpflda2o
+	PARAMETER(jpflda2o = 1)          ! Number of fields exchanged from
+                                         ! atmosphere to ocean
+C
+	INTEGER jpfldo2a
+	PARAMETER(jpfldo2a = 1)          ! Number of fields exchanged from
+                                         ! ocean to atmosphere
+C
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/param_sipc.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/param_sipc.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/param_sipc.h	(revision 79)
@@ -0,0 +1,21 @@
+C@
+C@ -- param_sipc.h
+C@
+C@ -- jpbyteint : number of bytes per integer
+C@
+C@ -- jpbyterea : number of bytes per real
+C@
+C@ -- jpbytecha : number of bytes per character
+C@
+	INTEGER jpbyteint,jpbyterea, jpbytecha  
+        PARAMETER (jpbyteint = 4)
+	PARAMETER (jpbyterea = 4)
+	PARAMETER (jpbytecha = 1)
+C@
+C@ -- jptest :  The models will test during 2*jptest seconds if the file 
+C@              DUMMY_SIPC has been created by OASIS, signaling that the
+C@              SHM pools are opened. After, they will abort.
+C@
+        INTEGER jptest
+        PARAMETER(jptest = 100)      
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/phyetat0.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/phyetat0.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/phyetat0.F	(revision 79)
@@ -2,5 +2,6 @@
      .            rlat,rlon,tsol,tsoil,deltat,qsol,snow,
      .           radsol,rugmer,agesno,clesphy0,
-     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0)
+     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
+     .           t_ancien,q_ancien,ancien_ok)
       IMPLICIT none
 c======================================================================
@@ -38,4 +39,7 @@
       REAL rugsrel(klon)
 
+      REAL t_ancien(klon,klev), q_ancien(klon,klev)
+      LOGICAL ancien_ok
+
       INTEGER        longcles
       PARAMETER    ( longcles = 20 )
@@ -674,4 +678,41 @@
       PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
 c
+c
+      ancien_ok = .TRUE.
+c
+      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
+            CALL abort
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
+      IF (ierr.NE.NF_NOERR) THEN
+         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
+#endif
+         IF (ierr.NE.NF_NOERR) THEN
+            PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
+            CALL abort
+         ENDIF
+      ENDIF
+c
 c Fermer le fichier:
 c
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/phyredem.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/phyredem.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/phyredem.F	(revision 79)
@@ -2,5 +2,6 @@
      .           rlat,rlon,tsol,tsoil,deltat,qsol,snow,
      .           radsol,rugmer,agesno,
-     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel)
+     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,
+     .           t_ancien, q_ancien)
       IMPLICIT none
 c======================================================================
@@ -15,4 +16,5 @@
 #include "clesphys.h"
 #include "control.h"
+#include "temps.h"
 c======================================================================
       CHARACTER*(*) fichnom
@@ -38,6 +40,7 @@
       REAL zval(klon)
       REAL rugsrel(klon)
-c
-      INTEGER nid, nvarid, idim1, idim2
+      REAL t_ancien(klon,klev), q_ancien(klon,klev)
+c
+      INTEGER nid, nvarid, idim1, idim2, idim3
       INTEGER ierr
       INTEGER length
@@ -61,4 +64,5 @@
       ierr = NF_DEF_DIM (nid, "index", length, idim1)
       ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
+      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
 c
       ierr = NF_ENDDEF(nid)
@@ -82,4 +86,6 @@
       tab_cntrl(13) = dayref
       tab_cntrl(14) = anneeref
+      tab_cntrl(13) = day_end
+      tab_cntrl(14) = anne_ini
 c
       ierr = NF_REDEF (nid)
@@ -388,4 +394,30 @@
 #endif
 c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_DOUBLE, 1, idim3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "QANCIEN", NF_FLOAT, 1, idim3,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q_ancien)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,q_ancien)
+#endif
+c
       ierr = NF_CLOSE(nid)
 c
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/physiq.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F	(revision 79)
@@ -3,5 +3,4 @@
      .            paprs,pplay,pphi,pphis,paire,presnivs,clesphy0,
      .            u,v,t,qx,
-     .            d_u_dyn, d_v_dyn,  d_t_dyn, d_qx_dyn,
      .            omega,
      .            d_u, d_v, d_t, d_qx, d_ps)
@@ -40,8 +39,6 @@
 c t-------input-R-temperature (K)
 c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
-c d_u_dyn-input-R-tendance dynamique pour "u" (m/s/s)
-c d_v_dyn-input-R-tendance dynamique pour "v" (m/s/s)
 c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
-c d_qx_dyn-input-R-tendance dynamique pour "qx" (kg/kg/s)
+c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
 c omega---input-R-vitesse verticale en Pa/s
 c
@@ -59,7 +56,10 @@
 #include "clesphys.h"
 #include "control.h"
+#include "temps.h"
 c======================================================================
       LOGICAL check ! Verifier la conservation du modele en eau
       PARAMETER (check=.FALSE.)
+      LOGICAL ok_stratus ! Ajouter artificiellement les stratus
+      PARAMETER (ok_stratus=.FALSE.)
 c======================================================================
 c Parametres lies au coupleur OASIS:
@@ -71,5 +71,7 @@
       PARAMETER (nexca=48)
       PARAMETER (itimestep=1800)
-      EXTERNAL intocpl, inicma
+      EXTERNAL fromcpl, intocpl, inicma
+      REAL cpl_sst(iim,jjm+1), cpl_sic(iim,jjm+1)
+      REAL cpl_alb_sst(iim,jjm+1), cpl_alb_sic(iim,jjm+1)
 c======================================================================
 c ok_ocean indique l'utilisation du modele oceanique "slab ocean",
@@ -156,8 +158,13 @@
       REAL qx(klon,klev,nqmax)
 
+      REAL t_ancien(klon,klev), q_ancien(klon,klev)
+      SAVE t_ancien, q_ancien
+      LOGICAL ancien_ok
+      SAVE ancien_ok
+
       REAL d_u_dyn(klon,klev)
       REAL d_v_dyn(klon,klev)
       REAL d_t_dyn(klon,klev)
-      REAL d_qx_dyn(klon,klev,2)
+      REAL d_q_dyn(klon,klev)
 
       REAL omega(klon,klev)
@@ -276,5 +283,6 @@
       REAL yv1(klon)            ! vents dans la premiere couche V
       LOGICAL offline           ! Controle du stockage ds "physique"
-      PARAMETER (offline=.TRUE.)
+      PARAMETER (offline=.true.)
+      INTEGER physid
       REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
       save pfrac_impa
@@ -402,4 +410,8 @@
       CHARACTER*2 iqn
 c
+      REAL qcheck
+      REAL z_avant(klon), z_apres(klon), z_factor(klon)
+      LOGICAL zx_ajustq
+c
       REAL za, zb
       REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
@@ -423,5 +435,5 @@
       REAL d_u_con(klon,klev),d_v_con(klon,klev)
       REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
-c      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
+      REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
       REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
       REAL rneb(klon,klev)
@@ -432,4 +444,5 @@
       INTEGER kcbot(klon), kctop(klon), kdtop(klon)
       REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
+      REAL prfl(klon,klev+1), psfl(klon,klev+1)
 c
       INTEGER ibas_con(klon), itop_con(klon)
@@ -505,5 +518,5 @@
       REAL tabcntr0( length       )
 c
-      INTEGER ndex(1)
+      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
       REAL zx_tmp_fi2d(klon)
       REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
@@ -579,5 +592,6 @@
      .         rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow,
      .        radsol,rugmer,agesno,clesphy0,
-     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0 )
+     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
+     .       t_ancien, q_ancien, ancien_ok )
 
 c
@@ -659,7 +673,6 @@
       IF (ok_journe) THEN
 c
-C         CALL ymds2ju(1900, 1, 1, 0.0, zjulian)
-         CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian)
-         zjulian = zjulian + dayref
+         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
+         zjulian = zjulian + day_ini
 c
          CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
@@ -809,13 +822,6 @@
          CALL histend(nid_day)
 c
-         ndex(1) = 0
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
+         ndex2d = 0
+         ndex3d = 0
 c
       ENDIF ! fin de test sur ok_journe
@@ -823,7 +829,6 @@
       IF (ok_mensuel) THEN
 c
-c         CALL ymds2ju(1900, 1, 1, 0.0, zjulian)
-         CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian)
-         zjulian = zjulian + dayref
+         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
+         zjulian = zjulian + day_ini
 c
          CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
@@ -1083,11 +1088,11 @@
      .                "ave(X)", zsto,zout)
 c
-c         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
-c     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-c     .                "ave(X)", zsto,zout)
-c
-c         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
-c     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
-c     .                "ave(X)", zsto,zout)
+         CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+         CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
+     .                iim,jjm+1,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
 c
          CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
@@ -1156,13 +1161,6 @@
          CALL histend(nid_mth)
 c
-         ndex(1) = 0
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-C
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
+         ndex2d = 0
+         ndex3d = 0
 c
       ENDIF ! fin de test sur ok_mensuel
@@ -1171,7 +1169,6 @@
       IF (ok_instan) THEN
 c
-c         CALL ymds2ju(1900, 1, 1, 0.0, zjulian)
-         CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian)
-         zjulian = zjulian + dayref
+         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
+         zjulian = zjulian + day_ini
 c
          CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
@@ -1237,13 +1234,6 @@
          CALL histend(nid_ins)
 c
-         ndex(1) = 0
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
+         ndex2d = 0
+         ndex3d = 0
 c
       ENDIF
@@ -1328,4 +1318,23 @@
       ENDIF
 c
+c Diagnostiquer la tendance dynamique
+c
+      IF (ancien_ok) THEN
+         DO k = 1, klev
+         DO i = 1, klon
+            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
+            d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
+         ENDDO
+         ENDDO
+      ELSE
+         DO k = 1, klev
+         DO i = 1, klon
+            d_t_dyn(i,k) = 0.0
+            d_q_dyn(i,k) = 0.0
+         ENDDO
+         ENDDO
+         ancien_ok = .TRUE.
+      ENDIF
+c
 c Ajouter le geopotentiel du sol:
 c
@@ -1356,4 +1365,53 @@
          CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
       ENDIF
+cccccccccc
+      IF (ok_oasis .AND. MOD(itap-1,nexca).EQ.0) THEN
+C
+         CALL fromcpl(itap,(jjm+1)*iim,
+     .        cpl_sst,cpl_sic,cpl_alb_sst,cpl_alb_sic)
+         DO i = 1, iim-1 ! un seul point pour le pole nord
+            cpl_sst(i,1) = cpl_sst(iim,1)
+            cpl_sic(i,1) = cpl_sic(iim,1)
+            cpl_alb_sst(i,1) = cpl_alb_sst(iim,1)
+            cpl_alb_sic(i,1) = cpl_alb_sic(iim,1)
+         ENDDO
+         DO i = 2, iim ! un seul point pour le pole sud
+            cpl_sst(i,jjm+1) = cpl_sst(1,jjm+1)
+            cpl_sic(i,jjm+1) = cpl_sic(1,jjm+1)
+            cpl_alb_sst(i,jjm+1) = cpl_alb_sst(1,jjm+1)
+            cpl_alb_sic(i,jjm+1) = cpl_alb_sic(1,jjm+1)
+         ENDDO
+c
+         ig = 1
+         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
+     .       pctsrf(ig,is_sic).GT.epsfra) THEN
+            pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
+     .                        - (cpl_sic(1,1)-pctsrf(ig,is_sic))
+            pctsrf(ig,is_sic) = cpl_sic(1,1)
+            lmt_sst(ig) = cpl_sst(1,1)
+         ENDIF
+         DO j = 2, jjm
+         DO i = 1, iim
+         ig = ig + 1
+         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
+     .       pctsrf(ig,is_sic).GT.epsfra) THEN
+           pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
+     .                       - (cpl_sic(i,j)-pctsrf(ig,is_sic))
+           pctsrf(ig,is_sic) = cpl_sic(i,j)
+           lmt_sst(ig) = cpl_sst(i,j)
+         ENDIF
+         ENDDO
+         ENDDO
+         ig = ig + 1
+         IF (pctsrf(ig,is_oce).GT.epsfra .OR.
+     .       pctsrf(ig,is_sic).GT.epsfra) THEN
+            pctsrf(ig,is_oce) = pctsrf(ig,is_oce)
+     .                        - (cpl_sic(1,jjm+1)-pctsrf(ig,is_sic))
+            pctsrf(ig,is_sic) = cpl_sic(1,jjm+1)
+            lmt_sst(ig) = cpl_sst(1,jjm+1)
+         ENDIF
+c
+      ENDIF ! ok_oasis
+cccccccccc
 c
  
@@ -1478,5 +1536,5 @@
       DO k = 1, klev
       DO i = 1, klon
-         conv_q(i,k) = d_qx_dyn(i,k,ivap) 
+         conv_q(i,k) = d_q_dyn(i,k) 
      .               + d_q_vdf(i,k)/dtime
          conv_t(i,k) = d_t_dyn(i,k) 
@@ -1485,5 +1543,19 @@
       ENDDO
       IF (check) THEN
-         CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"avantcon=")
+         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
+         PRINT*, "avantcon=", za
+      ENDIF
+      zx_ajustq = .FALSE.
+      IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
+      IF (zx_ajustq) THEN
+         DO i = 1, klon
+            z_avant(i) = 0.0
+         ENDDO
+         DO k = 1, klev
+         DO i = 1, klon
+            z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
+     .                        *(paprs(i,k)-paprs(i,k+1))/RG
+         ENDDO
+         ENDDO
       ENDIF
       IF (iflag_con.EQ.1) THEN
@@ -1522,12 +1594,39 @@
       ENDDO
       IF (check) THEN
-         CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"aprescon=")
+         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
+         PRINT*, "aprescon=", za
          zx_t = 0.0
+         za = 0.0
          DO i = 1, klon
-            zx_t = zx_t + rain_con(i)+snow_con(i)
-         ENDDO
-         zx_t = zx_t/FLOAT(klon)*dtime
+            za = za + paire(i)/FLOAT(klon)
+            zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
+        ENDDO
+         zx_t = zx_t/za*dtime
          PRINT*, "Precip=", zx_t
       ENDIF
+      IF (zx_ajustq) THEN
+         DO i = 1, klon
+            z_apres(i) = 0.0
+         ENDDO
+         DO k = 1, klev
+         DO i = 1, klon
+            z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
+     .                        *(paprs(i,k)-paprs(i,k+1))/RG
+         ENDDO
+         ENDDO
+         DO i = 1, klon
+         z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
+     .                /z_apres(i)
+         ENDDO
+         DO k = 1, klev
+         DO i = 1, klon
+         IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
+     .       z_factor(i).LT.(1.0-1.0E-08)) THEN
+               q_seri(i,k) = q_seri(i,k) * z_factor(i)
+         ENDIF
+         ENDDO
+         ENDDO
+      ENDIF
+      zx_ajustq=.FALSE.
 c
       IF (nqmax.GT.2) THEN !--melange convectif de traceurs
@@ -1543,5 +1642,11 @@
 c Appeler l'ajustement sec
 c
-C appel supprime pour le moment
+      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 Appeler le processus de condensation a grande echelle
@@ -1553,5 +1658,6 @@
      .           rain_lsc, snow_lsc,
      .           pfrac_impa, pfrac_nucl, pfrac_1nucl,
-     .           frac_impa, frac_nucl )
+     .           frac_impa, frac_nucl,
+     .           prfl, psfl)
       DO k = 1, klev
       DO i = 1, klon
@@ -1564,10 +1670,13 @@
       ENDDO
       IF (check) THEN
-         CALL qcheck(klon,klev,paprs,q_seri,ql_seri,"apresilp=")
+         za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
+         PRINT*, "apresilp=", za
          zx_t = 0.0
+         za = 0.0
          DO i = 1, klon
-            zx_t = zx_t + rain_lsc(i)+snow_lsc(i)
-         ENDDO
-         zx_t = zx_t/FLOAT(klon)*dtime
+            za = za + paire(i)/FLOAT(klon)
+            zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
+        ENDDO
+         zx_t = zx_t/za*dtime
          PRINT*, "Precip=", zx_t
       ENDIF
@@ -1576,7 +1685,21 @@
 c
       IF (iflag_con.EQ.2) THEN ! seulement pour Tiedtke
-      CALL diagcld(paprs,pplay,t_seri,q_seri,
+      CALL diagcld1(paprs,pplay,
      .             rain_con,snow_con,ibas_con,itop_con,
      .             diafra,dialiq)
+      DO k = 1, klev
+      DO i = 1, klon
+      IF (diafra(i,k).GT.cldfra(i,k)) THEN
+         cldliq(i,k) = dialiq(i,k)
+         cldfra(i,k) = diafra(i,k)
+      ENDIF
+      ENDDO
+      ENDDO
+      ENDIF
+c
+c Nuages stratus artificiels:
+c
+      IF (ok_stratus) THEN
+      CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
       DO k = 1, klev
       DO i = 1, klon
@@ -1807,9 +1930,12 @@
 
       IF (offline) THEN
-      call phystoke (
-     I                   nlon,nlev,pdtphys,
+
+	 call phystokenc (
+     I                   nlon,nlev,pdtphys,rlon,rlat,
      I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
      I                   ycoefh,yu1,yv1,ftsol,pctsrf,
-     I                   frac_impa, frac_nucl)
+     I                   frac_impa, frac_nucl,
+     I                   pphis,paire,dtime,itap,
+     O                   physid)
 
       ENDIF
@@ -1843,10 +1969,19 @@
       IF (ok_journe) THEN
 c
-      ndex(1) = 0
+      ndex2d = 0
+      ndex3d = 0
 c
 c Champs 2D:
 c
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
+         CALL histwrite(nid_day,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+c
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
+         CALL histwrite(nid_day,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+C
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1854,5 +1989,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1860,35 +1995,35 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, snow_fall,zx_tmp_2d)
-      CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, evap,zx_tmp_2d)
-      CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, bils,zx_tmp_2d)
-      CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, sens,zx_tmp_2d)
-      CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, fder,zx_tmp_2d)
-      CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, ruis,zx_tmp_2d)
-      CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1896,5 +2031,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1902,5 +2037,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1908,20 +2043,20 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldl,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldm,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldh,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldt,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldq,zx_tmp_2d)
-      CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_day,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
 c Champs 3D:
@@ -1929,41 +2064,52 @@
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
       CALL histwrite(nid_day,"temp",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,ivap), zx_tmp_3d)
       CALL histwrite(nid_day,"ovap",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
       CALL histwrite(nid_day,"geop",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
       CALL histwrite(nid_day,"vitu",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
       CALL histwrite(nid_day,"vitv",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, omega, zx_tmp_3d)
       CALL histwrite(nid_day,"vitw",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
       CALL histwrite(nid_day,"pres",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-c
-      if (ok_sync) call histsync
+     .                                   iim*(jjm+1)*klev,ndex3d)
+c
+      if (ok_sync) then
+        call histsync(nid_day)
+      endif
       ENDIF
 C
       IF (ok_mensuel) THEN
 c
-      ndex(1) = 0
+      ndex2d = 0
+      ndex3d = 0
 c
 c Champs 2D:
 c
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
+         CALL histwrite(nid_mth,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+C
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
+         CALL histwrite(nid_mth,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxtsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"tsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1971,8 +2117,8 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zxqsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"qsol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1980,5 +2126,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"rain",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1986,5 +2132,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"plul",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -1992,50 +2138,50 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"pluc",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, snow_fall,zx_tmp_2d)
-      CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"snow",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, agesno,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ages",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"ages",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, evap,zx_tmp_2d)
-      CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"evap",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"tops",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"sols",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"soll",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, topsw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"tops0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"topl0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, solsw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"sols0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, sollw0,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"soll0",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, bils,zx_tmp_2d)
-      CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"bils",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, sens,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"sens",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, fder,zx_tmp_2d)
-      CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"fder",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, ruis,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"ruis",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -2043,5 +2189,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"frtu",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -2049,5 +2195,5 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"frtv",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       DO i = 1, klon
@@ -2055,41 +2201,41 @@
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"sicf",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, albsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"albs",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cdragm,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cdrm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cdragh,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cdrh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldl,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cldl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldm,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cldm",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldh,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cldh",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldt,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cldt",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, cldq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"cldq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, ue,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"ue",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, ve,zx_tmp_2d)
-      CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"ve",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, uq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"uq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, vq,zx_tmp_2d)
-      CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
 c Champs 3D:
@@ -2097,123 +2243,122 @@
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
       CALL histwrite(nid_mth,"temp",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, qx(1,1,ivap), zx_tmp_3d)
       CALL histwrite(nid_mth,"ovap",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
       CALL histwrite(nid_mth,"geop",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
       CALL histwrite(nid_mth,"vitu",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
       CALL histwrite(nid_mth,"vitv",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, omega, zx_tmp_3d)
       CALL histwrite(nid_mth,"vitw",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
       CALL histwrite(nid_mth,"pres",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cldfra, zx_tmp_3d)
       CALL histwrite(nid_mth,"rneb",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zx_rh, zx_tmp_3d)
       CALL histwrite(nid_mth,"rhum",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cldliq, zx_tmp_3d)
       CALL histwrite(nid_mth,"oliq",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_dyn, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtdyn",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_qx_dyn(1,1,ivap),
-     .                 zx_tmp_3d)
+     .                                   iim*(jjm+1)*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_dyn, zx_tmp_3d)
       CALL histwrite(nid_mth,"dqdyn",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_con, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtcon",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_con, zx_tmp_3d)
       CALL histwrite(nid_mth,"dqcon",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_lsc, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtlsc",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_lsc, zx_tmp_3d)
       CALL histwrite(nid_mth,"dqlsc",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_vdf, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtvdf",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_vdf, zx_tmp_3d)
       CALL histwrite(nid_mth,"dqvdf",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_eva, zx_tmp_3d)
       CALL histwrite(nid_mth,"dteva",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_eva, zx_tmp_3d)
       CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-c
-C      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_ajs, zx_tmp_3d)
-C      CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
-C    .                                   iim*(jjm+1)*klev,ndex)
-c
-C      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_ajs, zx_tmp_3d)
-C      CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
-C     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_t_ajs, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dtajs",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
+c
+      CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_q_ajs, zx_tmp_3d)
+      CALL histwrite(nid_mth,"dqajs",itap,zx_tmp_3d,
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtswr",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, heat0, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtsw0",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cool, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtlwr",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, cool0, zx_tmp_3d)
       CALL histwrite(nid_mth,"dtlw0",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_vdf, zx_tmp_3d)
       CALL histwrite(nid_mth,"duvdf",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_vdf, zx_tmp_3d)
       CALL histwrite(nid_mth,"dvvdf",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       IF (ok_orodr) THEN
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_oro, zx_tmp_3d)
       CALL histwrite(nid_mth,"duoro",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_oro, zx_tmp_3d)
       CALL histwrite(nid_mth,"dvoro",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       ENDIF
@@ -2222,14 +2367,14 @@
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_u_lif, zx_tmp_3d)
       CALL histwrite(nid_mth,"dulif",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, d_v_lif, zx_tmp_3d)
       CALL histwrite(nid_mth,"dvlif",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
       ENDIF
 C
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, wo, zx_tmp_3d)
       CALL histwrite(nid_mth,"ozone",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       IF (nqmax.GE.3) THEN
@@ -2239,5 +2384,5 @@
          WRITE(str2,'(i2.2)') iq
          CALL histwrite(nid_mth,"trac"//str2,itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
       ELSE
          PRINT*, "Trop de traceurs"
@@ -2247,21 +2392,32 @@
       ENDIF
 c
-      if (ok_sync) call histsync
+      if (ok_sync) then
+        call histsync(nid_mth)
+      endif
       ENDIF
 c
       IF (ok_instan) THEN
 c
-      ndex(1) = 0
+      ndex2d = 0
+      ndex3d = 0
 c
 c Champs 2D:
 c
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
+         CALL histwrite(nid_ins,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+c
+         i = NINT(zout/zsto)
+         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
+         CALL histwrite(nid_ins,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex2d)
+
       DO i = 1, klon
          zx_tmp_fi2d(i) = paprs(i,1)
       ENDDO
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_ins,"psol",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
       CALL gr_fi_ecrit(1, klon,iim,jjm+1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex)
+      CALL histwrite(nid_ins,"topl",itap,zx_tmp_2d,iim*(jjm+1),ndex2d)
 c
 c Champs 3D:
@@ -2269,23 +2425,25 @@
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, t_seri, zx_tmp_3d)
       CALL histwrite(nid_ins,"temp",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, u_seri, zx_tmp_3d)
       CALL histwrite(nid_ins,"vitu",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, v_seri, zx_tmp_3d)
       CALL histwrite(nid_ins,"vitv",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zphi, zx_tmp_3d)
       CALL histwrite(nid_ins,"geop",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
 c
       CALL gr_fi_ecrit(klev,klon,iim,jjm+1, pplay, zx_tmp_3d)
       CALL histwrite(nid_ins,"pres",itap,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
-c
-      if (ok_sync) call histsync
+     .                                   iim*(jjm+1)*klev,ndex3d)
+c
+      if (ok_sync) then
+        call histsync(nid_ins)
+      endif
       ENDIF
 c
@@ -2433,4 +2591,13 @@
       ENDIF
 c
+c Sauvegarder les valeurs de t et q a la fin de la physique:
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         t_ancien(i,k) = t_seri(i,k)
+         q_ancien(i,k) = q_seri(i,k)
+      ENDDO
+      ENDDO
+c
 c====================================================================
 c Si c'est la fin, il faut conserver l'etat de redemarrage
@@ -2438,14 +2605,15 @@
 c
       IF (lafin) THEN
-         IF (ok_oasis) CALL quitcpl
+ccc         IF (ok_oasis) CALL quitcpl
          CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
      .        rlat,rlon,ftsol,ftsoil,deltat,fqsol,fsnow,
      .        radsol,rugmer,agesno,
-     .        zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro)
+     .        zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
+     .        t_ancien, q_ancien)
       ENDIF
 
       RETURN
       END
-      SUBROUTINE qcheck(klon,klev,paprs,q,ql,marque)
+      FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
       IMPLICIT none
 c
@@ -2456,18 +2624,23 @@
       INTEGER klon,klev
       REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
-      CHARACTER *(*) marque
-      REAL qtotal
+      REAL aire(klon)
+      REAL qtotal, zx, qcheck
       INTEGER i, k
 c
+      zx = 0.0
+      DO i = 1, klon
+         zx = zx + aire(i)
+      ENDDO
       qtotal = 0.0
       DO k = 1, klev
       DO i = 1, klon
-         qtotal = qtotal + (q(i,k)+ql(i,k))
+         qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
      .                     *(paprs(i,k)-paprs(i,k+1))/RG
       ENDDO
       ENDDO
 c
-      PRINT*, "Eau totale ",marque, qtotal/FLOAT(klon)
-c
+      qcheck = qtotal/zx
+c
+      RETURN
       END
       SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
@@ -2478,5 +2651,5 @@
 c
       INTEGER nfield,nlon,iim,jjmp1, jjm
-      REAL fi(nlon,nfield), ecrit(iim,jjmp1,nfield)
+      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
 c
       INTEGER i, j, n, ig
@@ -2485,14 +2658,12 @@
       DO n = 1, nfield
          DO i=1,iim
-            ecrit(i,1,n) = fi(1,n)
-            ecrit(i,jjm+1,n) = fi(nlon,n)
-         ENDDO
-         DO j = 2, jjm
-            ig = 2+(j-2)*iim
-            DO i = 1, iim
-               ecrit(i,j,n) = fi(ig-1+i,n)
-            ENDDO
+            ecrit(i,n) = fi(1,n)
+            ecrit(i+jjm*iim,n) = fi(nlon,n)
+         ENDDO
+         DO ig = 1, nlon - 2
+           ecrit(iim+ig,n) = fi(1+ig,n)
          ENDDO
       ENDDO
       RETURN
       END
+
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/phystokenc.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/phystokenc.F	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/phystokenc.F	(revision 79)
@@ -0,0 +1,313 @@
+      SUBROUTINE phystokenc (
+     I                   nlon,nlev,pdtphys,rlon,rlat,
+     I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
+     I                   pcoefh,yu1,yv1,ftsol,pctsrf,
+     I                   frac_impa,frac_nucl,
+     I                   pphis,paire,dtime,itap,
+     O                   physid)
+      USE ioipsl
+
+      IMPLICIT none
+
+c======================================================================
+c Auteur(s) FH
+c Objet: Moniteur general des tendances traceurs
+c
+
+c======================================================================
+#include "dimensions.h"
+#include "dimphy.h"
+#include "tracstoke.h"
+#include "indicesol.h"
+#include "control.h"
+c======================================================================
+
+c Arguments:
+c
+c   EN ENTREE:
+c   ==========
+c
+c   divers:
+c   -------
+c
+      integer nlon ! nombre de points horizontaux
+      integer nlev ! nombre de couches verticales
+      real pdtphys ! pas d'integration pour la physique (seconde)
+c
+      integer physid, itap
+      integer ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
+
+c   convection:
+c   -----------
+c
+      REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
+      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
+      REAL pen_u(klon,klev) ! flux entraine dans le panache montant
+      REAL pde_u(klon,klev) ! flux detraine dans le panache montant
+      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
+      REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
+c
+      REAL rlon(klon), rlat(klon), dtime
+      REAL zx_tmp_3d(iim,jjm+1,klev),zx_tmp_2d(iim,jjm+1)
+
+c   Couche limite:
+c   --------------
+c
+      REAL pcoefh(klon,klev)    ! coeff melange CL
+      REAL yv1(klon)
+      REAL yu1(klon),pphis(klon),paire(klon)
+c
+c   Lessivage:
+c   ----------
+c
+      REAL frac_impa(klon,klev)
+      REAL frac_nucl(klon,klev)
+c
+c Arguments necessaires pour les sources et puits de traceur
+C
+      real ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
+      real pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
+c======================================================================
+c
+      INTEGER i, k
+c
+      REAL mfu(klon,klev)  ! flux de masse dans le panache montant
+      REAL mfd(klon,klev)  ! flux de masse dans le panache descendant
+      REAL en_u(klon,klev) ! flux entraine dans le panache montant
+      REAL de_u(klon,klev) ! flux detraine dans le panache montant
+      REAL en_d(klon,klev) ! flux entraine dans le panache descendant
+      REAL de_d(klon,klev) ! flux detraine dans le panache descendant
+      REAL coefh(klon,klev) ! flux detraine dans le panache descendant
+
+      REAL pyu1(klon),pyv1(klon)
+      REAL pftsol(klon,nbsrf),ppsrf(klon,nbsrf)
+      real pftsol1(klon),pftsol2(klon),pftsol3(klon),pftsol4(klon)
+      real ppsrf1(klon),ppsrf2(klon),ppsrf3(klon),ppsrf4(klon)
+
+      REAL dtcum
+
+      integer iadvtr,irec
+      real zmin,zmax
+      logical ok_sync
+ 
+      save mfu,mfd,en_u,de_u,en_d,de_d,coefh,dtcum
+      save iadvtr,irec
+      save pyu1,pyv1,pftsol,ppsrf
+
+      data iadvtr,irec/0,1/
+c
+c   Couche limite:
+c======================================================================
+
+      ok_sync = .true.
+
+c     print*,'iadvtr= ',iadvtr
+c     print*,'istphy= ',istphy
+c     print*,'istdyn= ',istdyn
+
+      IF (iadvtr.eq.0) THEN
+	
+	CALL initphysto('phystoke',
+     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid)
+  	
+c	write(*,*) 'apres initphysto ds phystokenc' 
+
+	
+      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
+      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
+            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, 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)	
+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
+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
+      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.
+            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
+            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
+         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
+
+      RETURN
+      END
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/phylmd/phytrac.F	(revision 3)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/phytrac.F	(revision 79)
@@ -28,4 +28,5 @@
 #include "indicesol.h"
 #include "control.h"
+#include "temps.h"
 c======================================================================
 
@@ -130,5 +131,5 @@
       INTEGER nid_tra
       SAVE nid_tra
-      INTEGER ndex(1)
+      INTEGER ndex2d(iim*(jjm+1)),ndex3d(iim*(jjm+1)*klev)
       REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev)
       REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
@@ -140,4 +141,6 @@
       INTEGER ecrit_tra
       SAVE ecrit_tra   
+      logical ok_sync
+      parameter (ok_sync = .true.)
 C
 C nature du traceur
@@ -201,7 +204,9 @@
          modname='phytrac'
 
-         print*,'DANS PHYTRAC debutphy=',debutphy
+c        print*,'DANS PHYTRAC debutphy=',debutphy
 
          ecrit_tra = NINT(86400./pdtphys *ecritphy)   
+         zsto = pdtphys
+         zout = pdtphys * FLOAT(ecrit_tra)
          if (debutphy) then
 
@@ -217,6 +222,6 @@
          itra=0
 C         
-         CALL ymds2ju(anneeref, 1, 1, 0.0, zjulian)
-         zjulian = zjulian + dayref
+         CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian)
+         zjulian = zjulian + day_ini
 c
          CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon)
@@ -237,6 +242,4 @@
 C         CALL histvert(nid_tra, "presnivs", "Vertical levels", "mb",
 C     .                 klev, presnivs, nvert)
-         zsto = pdtphys
-         zout = pdtphys * FLOAT(ecrit_tra)
 c
          CALL histdef(nid_tra, "phis", "Surface geop. height", "-",
@@ -266,14 +269,5 @@
          ENDDO
          CALL histend(nid_tra)
-         ndex(1) = 0
-c
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
-         CALL histwrite(nid_tra,"phis",i,zx_tmp_2d,iim*(jjm+1),ndex)
-C
-         i = NINT(zout/zsto)
-         CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
-         CALL histwrite(nid_tra,"aire",i,zx_tmp_2d,iim*(jjm+1),ndex)
-c
+
 c======================================================================
 c   Initialisation de certaines variables pour le Rn et le Pb 
@@ -282,5 +276,5 @@
 c Initialisation du traceur dans le sol (couche limite radonique)
 c
-         print*,'valeur de debut dans phytrac :',debutphy
+c        print*,'valeur de debut dans phytrac :',debutphy
          do it=1,nqmax
             do i=1,klon
@@ -327,5 +321,5 @@
       if (convection) then
 
-      print*,'Pas de temps dans phytrac : ',pdtphys
+c     print*,'Pas de temps dans phytrac : ',pdtphys
       DO it=1, nqmax
       CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
@@ -339,5 +333,5 @@
       CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'convection it='//itn)
       ENDDO
-      print*,'apres nflxtr'
+c     print*,'apres nflxtr'
 
 
@@ -348,5 +342,5 @@
 c======================================================================
 
-      print*,'avant couchelimite'
+c     print*,'avant couchelimite'
       if (couchelimite) then
 
@@ -359,5 +353,5 @@
 C maf modif pour tenir compte du cas rnpb + traceur
       DO it=1, nqmax
-      print *,'it',it,clsol(it)
+c     print *,'it',it,clsol(it)
       if (clsol(it)) then  ! couche limite avec quantite dans le sol calculee
           CALL cltracrn(it, pdtphys, yu1, yv1,
@@ -407,5 +401,5 @@
       endif ! couche limite
 
-      print*,'apres couchelimite'
+c     print*,'apres couchelimite'
 
 c======================================================================
@@ -438,5 +432,5 @@
       IF (lessivage) THEN
 
-      print*,'avant lessivage'
+c     print*,'avant lessivage'
 
        DO it = 1, nqmax
@@ -497,5 +491,5 @@
       ENDDO
 c
-      print*,'apres lessivage'
+c     print*,'apres lessivage'
       ENDIF
 Cc
@@ -511,5 +505,16 @@
       ENDDO
       itra=itra+1
-      ndex(1) = 0
+
+C
+C Sorties IOIPSL
+      ndex2d = 0
+      ndex3d = 0
+c
+c     write(*,*)'sorties ioipsl phytrac',zsto,zout
+      CALL gr_fi_ecrit(1,klon,iim,jjm+1,pphis,zx_tmp_2d)
+      CALL histwrite(nid_tra,"phis",itra,zx_tmp_2d,iim*(jjm+1),ndex2d)
+C
+      CALL gr_fi_ecrit(1,klon,iim,jjm+1,paire,zx_tmp_2d)
+      CALL histwrite(nid_tra,"aire",itra,zx_tmp_2d,iim*(jjm+1),ndex2d)
       DO it=1,nqmax
       IF (it.LE.99) THEN
@@ -518,9 +523,9 @@
        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,tr_seri(1,1,it),zx_tmp_3d)
        CALL histwrite(nid_tra,"tr"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
        IF (lessivage) THEN
        CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flestottr(1,1,it),zx_tmp_3d)
        CALL histwrite(nid_tra,"fl"//str2,itra,zx_tmp_3d,
-     .                                   iim*(jjm+1)*klev,ndex)
+     .                                   iim*(jjm+1)*klev,ndex3d)
       ENDIF
       ELSE
@@ -529,4 +534,5 @@
       ENDIF
       ENDDO
+      if (ok_sync) call histsync(nid_tra)
 
       RETURN
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.160.98.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.160.98.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.160.98.h	(revision 79)
@@ -0,0 +1,2 @@
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=78,kflev=klev) ! 78*199
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.192.143.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.192.143.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.192.143.h	(revision 79)
@@ -0,0 +1,2 @@
+       INTEGER kdlon, kflev
+      PARAMETER (kdlon=10,kflev=klev)
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.32.24.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.32.24.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.32.24.h	(revision 79)
@@ -0,0 +1,2 @@
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=klon,kflev=klev)
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.48.32.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.48.32.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.48.32.h	(revision 79)
@@ -0,0 +1,2 @@
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=149,kflev=klev)
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.96.72.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.96.72.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.96.72.h	(revision 79)
@@ -0,0 +1,2 @@
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=487,kflev=klev)
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.defaut.h
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.defaut.h	(revision 79)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/raddim.defaut.h	(revision 79)
@@ -0,0 +1,2 @@
+      INTEGER kdlon, kflev
+      PARAMETER (kdlon=klon,kflev=klev)
Index: LMDZ.3.3/branches/rel-LF/makegcm
===================================================================
--- LMDZ.3.3/branches/LF/makegcm	(revision 3)
+++ 	(revision )
@@ -1,695 +1,0 @@
-#!/bin/csh
-#set verbose echo
-########################################################################
-# options par defaut pour la commande make
-########################################################################
-set dim="48x32x19"
-set physique=lmd
-set phys="PHYS=$physique"
-set include='-I$(LIBF)/grid -I$(LIBF)/bibio -I. '
-set ntrac = 4
-set filtre=filtrez
-set grille=reg
-########################################################################
-# path a changer contenant les sources et les objets du modele
-########################################################################
-
-###### VERSION LMDZ.3.3
-# set LMDGCM=$HOME/LMDZ.3.3
-#
-#   a changer  rlmd304/agcm
-#
-###### VERSION LMDZ.3.2
-
-if ( ! $?LMDGCM ) then
-   echo You must initialize the variable LMDGCM in your environnement
-   echo for instance: "setenv LMDGCM /usr/myself/supergcm" in .cshrc
-   exit
-endif
-if ( ! $?LIBOGCM ) then
-   set LIBOGCM=$LMDGCM/libo
-endif
-if ( ! $?IOIPSLDIR ) then
-   echo You must initialize the variable IOIPSLDIR in your environnement
-   echo for instance: "setenv IOIPSLDIR /usr/myself/ioipsl" in .cshrc
-   exit
-endif
-if ( ! $?NCDFLIB ) then
-   echo You must initialize the variable NCDFLIB in your environnement
-   echo for instance: "setenv NCDFLIB /usr/myself/netcdf" in .cshrc
-   exit
-endif
-if ( ! $?NCDFINC ) then
-   echo You must initialize the variable NCDFINC in your environnement
-   echo for instance: "setenv NCDFINC /usr/myself/netcdf" in .cshrc
-   exit
-endif
-set model=$LMDGCM
-set libo=$LIBOGCM
-
-########################################################################
-#  Les differentes platformes reconnues
-########################################################################
-
-set HP=0
-set IBM=0
-set SUN=0
-set VPP=0
-set CRAY=0
-set DEC=0
-set LINUX=0
-set NEC=0
-if ( `uname` == HP-UX ) then
-   set machine=HP
-   set HP=1
-else if (`uname` == UNIX_System_V ) then
-   set machine=VPP
-   set VPP=1
-else if (`uname` == SunOS ) then
-   set machine=SUN
-   set SUN=1
-else if ( `uname` == AIX ) then
-   set machine=IBM
-   set IBM=1
-else if ( `uname` == OSF1 ) then
-   set machine=ALPHA
-   set DEC=1
-else if ( `uname` == Linux ) then
-   set machine=LINUX
-   set LINUX=1
-else if ( `hostname` == atlas || `hostname` == axis  || `hostname` == etoile ) then
-   set machine=CRAY
-   set CRAY=1
-else if ( `hostname` == rhodes ) then
-   set machine=NEC
-   set NEC=1
-else
-   echo Vous travaillez sur une machine non prevue par le reglement
-   exit
-endif
-
-if ( ! -d $libo )  then
-   mkdir $libo
-endif
-
-
-if $VPP then
-set netcdf=netcdf_v
-else 
-set netcdf=netcdf
-endif
-########################################################################
-#  Quelques initialisations de variables du shell.
-########################################################################
-
-set dyn=
-set opt_link=""
-set adjnt=""
-set opt_dep=""
-
-set optim=""
-set optimbis=""
-set optim90=""
-set oplink=""
-
-########################################################################
-#  Optimisations par defaut suivant les machines
-########################################################################
-
-echo "Optimisations par defaut suivant les machines"
-set libf=$model/libf
-#setenv localdir "LOCAL_DIR=`pwd`"
-setenv localdir "`pwd`"
-cd $model
-if $CRAY then
-#   set optim="-Wf'-ei' -dp -Wf'-a static'"
-   set optimbis=" -DCRAY "
-   set optim90="-Wp'-P' -DCRAY -p$IOIPSLDIR "'-p$(LIBO) -eiv '
-   set optim="$optim90"
-   set oplink="-Wl'-DSTACK=128 -f indef' -L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf "
-   set mod_loc_dir=" "
-   set mod_suffix=" "
-else if $SUN then
-   set optim=" -fast "
-   set optimbis=" "
-   set optim90=" -fast -fixed "
-   set opt_link="-lf77compat -L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
-   set mod_loc_dir=$localdir
-   set mod_suffix=mod
-else if $HP then
-   set optim=" +U77 -O +E1 "
-   set optimbis=" "
-else if $IBM then
-   set optim=" -O3 -qtune=pwr2 -qarch=pwr2"
-   set optimbis=" "
-else if $VPP then
-   set optim=" -Ad -Of -Wv,-Of,-ilfunc"
-   set optimbis=" -Psia -Aa -Wv,-m3 -Wp,-DVPP,-DNC_DOUBLE -Z $LMDGCM/listage"
-   set optim=" -Of -Wv,-Of,-ilfunc"
-   set optimbis=" -Psia -Aa -Wv,-m3 -Wp,-DVPP -Z $LMDGCM/listage"
-   set optim90="$optim""$optimbis"" -X9 -w"
-   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
-   set oplink=" "
-   set mod_loc_dir=$IOIPSLDIR
-   set mod_suffix=mod
-else if $DEC then
-   set optim=" "
-   set optimbis=" "
-else if $LINUX then
-   set optim="-fast "
-   set optim90=" -fast -module $libo"
-   set opt_link=" -Mfree -L/usr/local/pgi/linux86/lib -lpgf90 -lpgftnrtl -lpghpf -lpghpf2 -L$NCDFLIB -lnetcdf -L$IOIPSLDIR -lioipsl -Wl,-Bstatic "
-   set mod_loc_dir=$IOIPSLDIR
-   set mod_suffix=mod
-else if $NEC then
-set optim90=' -C hopt -float0 -ew -R4 -L nostdout -Wf,"-pvctlfullmsg noassume loopcnt=150000 -L transform"'
-   set optim90=' -C hopt -float0 -ew -R4 -L nostdout '
-   set optim="$optim90"
-   set opt_link="-L/u/rech/ces/rces011/ioipsl"
-   set optimbis=" "
-   set mod_loc_dir=" "
-   set mod_suffix=" "
-else
-   set optim=""
-   set optimbis=" "
-endif
-
-set nomlib=$machine
-
-########################################################################
-# lecture des options de mymake
-########################################################################
-
-top:
-if ($#argv > 0) then
-    switch ($1:q)
-
-    case -h:
-
-########################################################################
-# Manuel en ligne
-########################################################################
-more <<eod
-
-
-makegcm [Options] prog
-
-
-
-
-Par default, la commande makegcm:
----------------------------------
-
-1. compile une serie de sous programmes se trouvant dans des sous-repertoires
-de $LMDGCM/libf.
-Les sous programmes sont ensuite stokes sur dans des librairies FORTRAN
-sur $LIBOGCM.
-
-2. Ensuite, makegcm compile le programme prog.f se trouvant par default sur
-$LMDGCM/libf/dyn3d et effectue le lien avec l ensemble des librairies.
-
-La variable '$LMDGCM' doit etre initialisee dans votre .cshrc ou en dur
-dans la comande makegcm.
-
-La commande makegcm est faite pour permettre de gerer en parallele des
-versions differentes du modele, compilees avec des options de compilation
-et des dimensions differentes sans avoir a chaque fois a recompiler tout
-le modele.
-
-Les librairies FORTRAN sont stoquees sur le directory $LIBOGCM.
-
-
-OPTIONS:
---------
-
-Les options suivantes peuvent etre definies soit par defaut en editant le
-"script" makegcm, soit en interactif:
-
--d imxjmxlm  ou im, jm, et lm sont resp. le nombre de longitudes, latitudes
-             et couches verticales. 
-
--t ntrac   selectionne le nombre de traceur advectes par la dynamique.
-           Dans les versions courantes du modele terrestre on a par exemple
-           ntrac=2 pour l'eau vapeur et liquide
-
-             L'effet des options -d et -t est d'ecraser le fichier 
-             $LMDGCM/libf/grid/dimensions.h
-             qui contient sous forme de 4 PARAMETER FORTRAN les 3 dimensions
-             de la grille horizontale im, jm, lm plus le nombre de traceurs
-             advectes passivement par la dynamique ntrac, par un nouveu fichier
-             $LMDGCM/libf/grid/dimension/dimensions.im.jm.lm.tntrac
-             Si ce fichier n'existe pas encore, il est cree par le script
-             $LMDGCM/libf/grid/dimension/makdim
-
--p PHYS    pour selectionner le jeu de parametrisations physiques avec
-           lequel on veut compiler le modele.
-           Le modele sera alors compile en prenant les sources des
-           parametrisations physiques dans le repertoire:
-            $LMDGCM/libf/phyPHYS
-
--g grille  selectionne le type de grille qu'on veut utiliser.
-           L'effet de cette option est d'ecraser le fichier
-           $LMDGCM/libf/grid/fxyprim.h
-           avec le fichier
-           $LMDGCM/libf/grid/fxy_grille.h
-           grille peut prendre les valeurs:
-           1. reg pour la grille reguliere
-           2. sin pour avoir des points equidistants en sinus de la latitude
-           3. new pour pouvoir zoomer sur une partie du globe
-
--O "optimisation fortran" ou les optimisations fortran sont les options de la
-            commande f77
-
--include path
-           Dans le cas ou on a dans des sous programmes des fichiers 
-           #include (cpp) qui se trouve sur des repertoires non references
-           par defaut
-
--adjnt     Pour compiler la l'adjoint du code dynamique
-
--filtre  filtre
-           Pour choisir le filtre en longitude dans les regions polaires.
-           "filtre" correspond au nom d'un repertoire se trouvant sur
-           $LMDGCM/libf. Le filtre standard du modele est "filtrez" qui peut
-           etre utilise aussi bien pour une grille reguliere que pour une 
-           grille zoomee en longitude.
-
--link "-Ldir1 -lfile1 -Ldir2 -lfile2 ..."
-          Pour rajouter un lien avec les librairies FORTRAN
-          libfile1.a, libfile2.a ... se trouvant respectivement sur les
-          repertoires dir1, dir2 ...
-          Si dirn est un repertoire dont le chemin est automatique (comme
-          par exemple /usr/lib ...) il n'est pas besoin de specifier -Ldirn.
-
-Auteur: Frederic Hourdin  (hourdin@lmd.jussieu.fr)
-eod
-exit
-
-########################################################################
-# Lecture des differentes options
-########################################################################
-
-    case -d:
-        set dim=$2 ; shift ; shift ; goto top
-                        
-    case -O:
-        set optim="$2" ; shift ; shift ; goto top
-
-     case -p
-        set physique="$2" ; set phys="PHYS=$physique" ; shift ; shift ; goto top
-
-     case -g
-        set grille="$2" ; shift ; shift ; goto top
-
-     case -t
-        set ntrac=$2 ; shift ; shift ; goto top
-
-     case -include
-        set include="$include -I$2" ; shift ; shift ; goto top
-
-     case -adjnt
-        set opt_dep="$opt_dep adjnt" ; set adjnt="-ladjnt -ldyn3d "
-        set optim="$optim -Dadj" ; shift ; goto top
-
-     case -filtre
-        set filtre=$2 ; shift ; shift ; goto top
-
-     case -link
-        set opt_link="$2" ; shift ; shift ; goto top
-
-     case -debug
-        if $HP then
-           set optim=" -g "
-        else if $SUN then
-           setenv PARALLEL 2
-           set optim=" -g -C "
-           set optim90=" -fixed -g "
-        else if $CRAY then
-           set optim="$optim"" -g "
-           set optim90="$optim90"" -G1 "
-        else if $LINUX then
-           set optim="$optim"" -g -Mbounds "
-           set optim90="$optim90"" -g -Mbounds "
-        else 
-           echo pas d option debug predefinie pour cette machine
-           exit
-        endif
-        shift ; goto top
-
-     default
-        set code="$1" ; shift ; goto top
-
-   endsw
-endif
-
-########################################################################
-# cas special sans physique
-########################################################################
-if ( "$physique" == 'nophys' ) then
-   set phys="L_PHY= LIBPHY="
-endif
-
-########################################################################
-# choix du nombre de traceur par defaut si il n'a pas ete choisi,
-# suivant la physique
-########################################################################
-
-if ( $ntrac == 0  ) then
-    if ( "$physique" == 'nophys' ) then
-        set ntrac=1
-    else if ( "$physique" == 'lmd' ) then
-        set ntrac=2
-    else if ( "$physique" == 'lmd_test_li' ) then
-        set ntrac=2
-    else if ( "$physique" == 'ec' ) then
-        set ntrac=1
-    else
-        set ntrac = 1
-    endif
-endif
-
-########################################################################
-#subtilites sur le nom de la librairie
-########################################################################
-
-\rm tmp ; touch tmp
-\rm tmp90 ; touch tmp90
-foreach i ( $optim )
-   echo $i | sed -e 's/\"//g' -e "s/\'//g" -e 's/-//g'  >> tmp
-end
-set suf=
-foreach i ( `sort tmp | uniq ` )
-   set suf=$suf$i
-end
-if ( ! $IBM ) then
-   set nomlib="$nomlib$suf"
-endif
-if ( $DEC ) then
-   set nomlib=DEC
-endif
-if ( $IBM ) then
-   set dim=`echo $dim | sed -en 's/[^0-9]/ /g'`
-   set dim_=`echo $dim | sed -en 's/[^0-9]/_/g'`
-else
-   set dim=`echo $dim | sed -n -e 's/[^0-9]/ /gp'`
-   set dim_=`echo $dim | sed -n -e 's/[^0-9]/_/gp'`
-endif
-set nomlib=${nomlib}_${dim_}_t${ntrac}_$grille
-## M-A-F nomlib trop long sur CRAY pour ar
-if ( $CRAY ) then
-    set nomlib=F90_${dim_}_t${ntrac}
-endif
-if ( $NEC ) then
-    set nomlib=F90_${dim_}_t${ntrac}
-endif
-echo calcul de la dimension
-set dimc=`echo $dim | wc -w`
-
-if ( "$dimc" == "2" ) then
-set include="$include "'-I$(LIBF)/dyn2d '
-set dimh=$dim
-else
-set include="$include "'-I$(LIBF)/dyn3d '
-set dimh=`echo $dim | awk ' { print $1 "." $2 } '`
-endif
-echo $dimc
-
-########################################################################
-# path pour les #include
-########################################################################
-
-set include="$include -I$NCDFINC -I$IOIPSLDIR"
-echo $include
-
-########################################################################
-# Gestion des dimensions du modele.
-# on cree ou remplace le fichier des dimensions/nombre de traceur
-########################################################################
-
-cd $libf/grid
-if ( -f dimensions.h ) then
-echo 'ATTENTION: vous etes sans doute en train de compiler le modele par ailleurs'
-echo "Attendez que la premiere compilation soit terminee pour relancer la suivante."
-echo "Si vous etes sur que vous ne compilez pas le modele par ailleurs,"
-echo  vous pouvez continuer en repondant oui.
-echo "Voulez-vous vraiment continuer?"
-if ( $< == "oui" ) then
-\rm $libf/grid/dimensions.h
-else
-exit
-endif
-endif
-
-cd dimension
-makdim $ntrac $dim
-cat $libf/grid/dimensions.h
-
-cd $LMDGCM
-set libo=$libo/$nomlib
-if ( ! -d $libo )  then
-   mkdir $libo
-   cd $model
-endif
-
-########################################################################
-# Differentes dynamiques (3d, 2d, 1d)
-########################################################################
-
-set dimension=`echo $dim | wc -w`
-echo dimension $dimension
-if ( $dimension == 1 ) then
-echo pas de dynamique
-set dyn="L_DYN= DYN= L_FILTRE= DIRMAIN=phy$physique "
-endif
-endif
-cd $model
-if ( $dimension == 3 ) then
-cd libf/grid
-\rm fxyprim.h
-cp -p fxy_${grille}.h fxyprim.h
-endif
-
-######################################################################
-#   Traitement special pour le nouveau rayonnement de Laurent Li.
-######################################################################
-
-if ( -f $libf/phy$physique/raddim.h ) then
-if ( -f $libf/phy$physique/raddim.$dimh.h ) then
-\rm $libf/phy$physique/raddim.h
-cp -p $libf/phy$physique/raddim.$dimh.h $libf/phy$physique/raddim.h
-echo $libf/phy$physique/raddim.$dimh.h 
-cat $libf/phy$physique/raddim.$dimh.h 
-cat $libf/phy$physique/raddim.h
-else
-echo On peut diminuer la taille de l executable en creant
-echo le fichier $libf/phy$physique/raddim.$dimh.h
-\cp -p $libf/phy$physique/raddim.defaut.h $libf/phy$physique/raddim.h
-endif
-endif
-
-######################################################################
-# Gestion du filtre qui n'existe qu'en 3d.
-######################################################################
-
-if ( `expr $dimc \> 2` == 1 ) then
-   set filtre="FILTRE=$filtre"
-else
-   set filtre="FILTRE= L_FILTRE= "
-endif
-echo MACRO FILTRE $filtre
-
-echo $dimc
-
-########################################################################
-#  Avant de lancer le make, on recree le makefile si necessaire
-########################################################################
-# c'est a dire dans 3 cas:
-# 1. si la liste des fichiers .F et .h a ete modifiee depuis la
-#    derniere creation du makefile
-# 2. si le fichier contenant cette liste "liste_des_sources"
-#    n'existe pas.
-# 3. Si le makefile n'existe pas.
-########################################################################
-
-cd $model
-find libf -name '*.[Fh]' -print >! tmp77
-find libf -name '*.[Fh]' -exec egrep -i " *use *ioipsl" {} \; -print >! tmp90
-
-if (    `diff tmp77 liste_des_sources_f77 | wc -w` \
-     || `diff tmp90 liste_des_sources_f90 | wc -w` \
-     || ! -f makefile \
-     || ! -f liste_des_sources_f90 \
-     || ! -f liste_des_sources_f77 ) then
-        echo les fichiers suivants ont ete crees ou detruits
-        echo ou les fichiers suivants sont passes ou ne sont plus en Fortran 90
-        diff liste_des_sources_f77 tmp77
-        diff liste_des_sources_f90 tmp90
-        \cp tmp77 liste_des_sources_f77
-        \cp tmp90 liste_des_sources_f90
-        echo On recree le makefile
-        ./create_make_gcm >! tmp
-        \mv tmp makefile
-        echo Nouveau makefile cree.
-endif
-
-########################################################################
-#  Execution de la comande make
-########################################################################
-
-echo PHYSIQUE $phys
-echo dynamique $dyn $dimension
-echo OPTIM="$optim" $filtre LIBO=$libo $dyn PHYS=$phys DIM=$dimc PROG=$code
-echo PATH pour les fichiers INCLUDE $include
-echo OPLINK="$oplink"
-
-if $HP then
-   set f77='fort77 +OP'
-   set f90='jensaisrien'
-   set opt_link="$opt_link -lm"
-else  if $VPP then
-   set f77=frt
-   set f90=$f77
-else if $CRAY then
-   set f77=f90
-   set f90=f90
-else if $LINUX then
-   set f77=pgf77
-   set f90=pgf90
-else if $SUN then
-   set f77=f90
-   set f90=f90
-else if $NEC then
-   set f77=sxf90
-   set f90=sxf90
-else
-   set f77=f77
-   set f90=f90
-endif
-
-cd $model
-
-if $VPP then
-set make="gmake RANLIB=ls"
-else if $CRAY then
-set make="make RANLIB=ls"
-else if $NEC then
-set make="make RANLIB=ls"
-else if $LINUX then
-set make="make -k RANLIB=ranlib"
-else
-set make="make RANLIB=ranlib"
-endif
-
-
-
-set link="$f90 $optim90"
-
-if $NEC then
-  set link="sxld $opt_link"
-  set ar=sxar
-endif
-
-#
-# les deux test suivants sont "temporaires" pour pallier des "faiblesses" du 
-# compilateur fortran Sun: f90: SC4.0 11 Sep 1995 FORTRAN 90 1.1
-#
-#if ($code == 'create_limit' && $SUN) then
-#   set link=f77
-#   set opt_link="-L$NCDFLIB -lnetcdf"
-#endif
-
-#if ($code == 'create_etat0' && $SUN) then
-#   if ( ! -f $libo/libdyn3d.a ) then
-#     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
-#     \rm $libf/grid/dimensions.h
-#     exit
-#   endif
-#   set optim=" -dalign "
-#   set optim90=" -dalign -fixed "
-#   set opt_link="-L$IOIPSLDIR -lioipsl  -L$NCDFLIB -lnetcdf"
-#   set link="$f90 $optim90"
-#   touch $LMDGCM/libf/dyn3d/startvar.F
-#   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
-#endif
-
-#
-# Encore un test temporaire: probleme de compilation sur VPP
-# l'optimisation de startvar se passe mal
-#
-if ($code == 'create_etat0' && $VPP) then
-   if ( ! -f $libo/libdyn3d.a ) then
-     echo "Priere de compiler gcm en premier pour des raisons d'optimisation"
-     \rm $libf/grid/dimensions.h                                             
-     exit                       
-   endif
-   set optim=" -Ad -Wv,-Of,-ilfunc"
-   set optimbis=" -Psia -Aa -Wv,-m3 -Wp,-DVPP,-DNC_DOUBLE -Z $LMDGCM/listage"
-   set optim90="$optim""$optimbis"" -X9 -w"
-   set opt_link="-L$IOIPSLDIR -lioipsl -L$NCDFLIB -lnetcdf"
-   touch $LMDGCM/libf/dyn3d/startvar.F
-   touch $LMDGCM/libf/dyn3d/etat0_netcdf.F
-endif
-
-#################################################################
-# Execution de la comande make... ENFIN!
-#################################################################
-
-if $VPP then
-  set optim90=" $optim90 -Am -M$libo"
- \cp $IOIPSLDIR/*.mod $libo
-else if $SUN then
- set optim90=" $optim90 -M$IOIPSLDIR -M$libo "
- set optim="$optim90"
- \cp $IOIPSLDIR/*.mod $libo
-else if $LINUX then
- set optim90=" -fast -module $libo "
- set mod_loc_dir=$libo
- \cp $IOIPSLDIR/*.mod $libo
-endif
-
-cd $localdir
-
-
-echo $make -f $LMDGCM/makefile \
-OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
-OPTIM90="$optim90" \
-OPTIM="$optim$optimbis" \
-INCLUDE="$include" \
-$filtre \
-LIBO=$libo \
-$dyn \
-$phys \
-DIM=$dimc \
-L_ADJNT="$adjnt" \
-LOCAL_DIR="$localdir"  \
-F77="$f77" \
-F90="$f90" \
-OPLINK="$oplink" \
-LINK="$link" \
-GCM="$LMDGCM" \
-MOD_LOC_DIR=$mod_loc_dir \
-MOD_SUFFIX=$mod_suffix \
-PROG=$code
-
-$make -f $LMDGCM/makefile \
-OPTION_DEP="$opt_dep" OPTION_LINK="$opt_link" \
-OPTIM90="$optim90" \
-OPTIM="$optim$optimbis" \
-INCLUDE="$include" \
-$filtre \
-LIBO=$libo \
-$dyn \
-$phys \
-DIM=$dimc \
-L_ADJNT="$adjnt" \
-LOCAL_DIR="$localdir"  \
-F77="$f77" \
-F90="$f90" \
-OPLINK="$oplink" \
-LINK="$link" \
-GCM="$LMDGCM" \
-MOD_LOC_DIR=$mod_loc_dir \
-MOD_SUFFIX=$mod_suffix \
-PROG=$code
-
-\rm $libf/grid/dimensions.h
