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)
