Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/abort_gcm.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/abort_gcm.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/abort_gcm.F	(revision 497)
@@ -1,2 +1,5 @@
+c
+c $Header$
+c
       SUBROUTINE abort_gcm(modname, message, ierr)
      
@@ -16,4 +19,6 @@
       write(*,*) 'in abort_gcm'
       call histclo
+      call restclo
+c     call getin_dump
 c     call histclo(2)
 c     call histclo(3)
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/addfi.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/addfi.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/addfi.F	(revision 497)
@@ -67,6 +67,7 @@
       REAL xpn(iim),xps(iim),tpn,tps
       INTEGER j,k,iq,ij
-      REAL qtest
-      PARAMETER ( qtest = 1.0e-30 )
+      REAL qtestw, qtestt
+      PARAMETER ( qtestw = 1.0e-15 )
+      PARAMETER ( qtestt = 1.0e-40 )
 
       REAL SSUM
@@ -81,19 +82,17 @@
       ENDDO
 
-      IF( alphax.NE.0. )   THEN
-        DO  k    = 1, llm
-         DO  ij   = 1, iim
-          xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
-          xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
-         ENDDO
-          tpn      = SSUM(iim,xpn,1)/ apoln
-          tps      = SSUM(iim,xps,1)/ apols
+      DO  k    = 1, llm
+       DO  ij   = 1, iim
+         xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
+         xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
+       ENDDO
+       tpn      = SSUM(iim,xpn,1)/ apoln
+       tps      = SSUM(iim,xps,1)/ apols
 
-         DO ij   = 1, iip1
-          pteta(   ij   ,k)  = tpn
-          pteta(ij+ip1jm,k)  = tps
-         ENDDO
-        ENDDO
-      ENDIF
+       DO ij   = 1, iip1
+         pteta(   ij   ,k)  = tpn
+         pteta(ij+ip1jm,k)  = tps
+       ENDDO
+      ENDDO
 c
 
@@ -114,13 +113,19 @@
          pps(j) = pps(j) + pdpfi(j) * pdt
       ENDDO
-
-c
-
-      DO iq = 1, nq
+ 
+      DO iq = 1, 2
          DO k = 1,llm
             DO j = 1,ip1jmp1
                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
-               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtest )
-ccc              pq(j,k,iq)=qtest
+               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO iq = 3, nq
+         DO k = 1,llm
+            DO j = 1,ip1jmp1
+               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
+               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
             ENDDO
          ENDDO
@@ -128,37 +133,32 @@
 
 
-      IF( alphax.NE.0. )   THEN
+      DO  ij   = 1, iim
+        xpn(ij) = aire(   ij   ) * pps(  ij     )
+        xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
+      ENDDO
+      tpn      = SSUM(iim,xpn,1)/apoln
+      tps      = SSUM(iim,xps,1)/apols
 
-         DO  ij   = 1, iim
-          xpn(ij) = aire(   ij   ) * pps(  ij     )
-          xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
-         ENDDO
+      DO ij   = 1, iip1
+        pps (   ij     )  = tpn
+        pps ( ij+ip1jm )  = tps
+      ENDDO
+
+
+      DO iq = 1, nq
+        DO  k    = 1, llm
+          DO  ij   = 1, iim
+            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
+            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
+          ENDDO
           tpn      = SSUM(iim,xpn,1)/apoln
           tps      = SSUM(iim,xps,1)/apols
 
-         DO ij   = 1, iip1
-          pps (   ij     )  = tpn
-          pps ( ij+ip1jm )  = tps
-         ENDDO
-
-
-       DO iq = 1, nq
-         DO  k    = 1, llm
-           DO  ij   = 1, iim
-            xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
-            xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
-           ENDDO
-            tpn      = SSUM(iim,xpn,1)/apoln
-            tps      = SSUM(iim,xps,1)/apols
-
-           DO ij   = 1, iip1
+          DO ij   = 1, iip1
             pq (   ij   ,k,iq)  = tpn
             pq (ij+ip1jm,k,iq)  = tps
-           ENDDO
-         ENDDO
-       ENDDO
-
-      ENDIF
-
+          ENDDO
+        ENDDO
+      ENDDO
 
       RETURN
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/bilan_dyn.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/bilan_dyn.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/bilan_dyn.F	(revision 497)
@@ -0,0 +1,568 @@
+      SUBROUTINE bilan_dyn (ntrac,dt_app,dt_cum,
+     s  ps,masse,pk,flux_u,flux_v,teta,phi,ucov,vcov,trac)
+
+c   AFAIRE
+c   Prevoir en champ nq+1 le diagnostique de l'energie
+c   en faisant Qzon=Cv T + L * ...
+c             vQ..A=Cp T + L * ...
+
+      USE IOIPSL
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "temps.h"
+
+c====================================================================
+c
+c   Sous-programme consacre à des diagnostics dynamiques de base
+c
+c 
+c   De facon generale, les moyennes des scalaires Q sont ponderees par
+c   la masse.
+c
+c   Les flux de masse sont eux simplement moyennes.
+c
+c====================================================================
+
+c   Arguments :
+c   ===========
+
+      integer ntrac
+      real dt_app,dt_cum
+      real ps(iip1,jjp1)
+      real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)
+      real flux_u(iip1,jjp1,llm)
+      real flux_v(iip1,jjm,llm)
+      real teta(iip1,jjp1,llm)
+      real phi(iip1,jjp1,llm)
+      real ucov(iip1,jjp1,llm)
+      real vcov(iip1,jjm,llm)
+      real trac(iip1,jjp1,llm,ntrac)
+
+c   Local :
+c   =======
+
+      integer icum,ncum
+      logical first
+      real zz,zqy,zfactv(jjm,llm)
+
+      integer nQ
+      parameter (nQ=7)
+
+
+      character*6 nom(nQ)
+      character*6 unites(nQ)
+      character*10 file
+      integer ifile
+      parameter (ifile=4)
+
+      integer itemp,igeop,iecin,iang,iu,iovap,iun
+      integer i_sortie
+
+      save first,icum,ncum
+      save itemp,igeop,iecin,iang,iu,iovap,iun
+      save i_sortie
+
+      real time
+      integer itau
+      save time,itau
+      data time,itau/0.,0/
+
+      data first/.true./
+      data itemp,igeop,iecin,iang,iu,iovap,iun/1,2,3,4,5,6,7/
+      data i_sortie/1/
+
+      real ww
+
+c   variables dynamiques intermédiaires
+      REAL vcont(iip1,jjm,llm),ucont(iip1,jjp1,llm)
+      REAL ang(iip1,jjp1,llm),unat(iip1,jjp1,llm)
+      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
+      REAL vorpot(iip1,jjm,llm)
+      REAL w(iip1,jjp1,llm),ecin(iip1,jjp1,llm),convm(iip1,jjp1,llm)
+      REAL bern(iip1,jjp1,llm)
+
+c   champ contenant les scalaires advectés.
+      real Q(iip1,jjp1,llm,nQ)
+    
+c   champs cumulés
+      real ps_cum(iip1,jjp1)
+      real masse_cum(iip1,jjp1,llm)
+      real flux_u_cum(iip1,jjp1,llm)
+      real flux_v_cum(iip1,jjm,llm)
+      real Q_cum(iip1,jjp1,llm,nQ)
+      real flux_uQ_cum(iip1,jjp1,llm,nQ)
+      real flux_vQ_cum(iip1,jjm,llm,nQ)
+      real flux_wQ_cum(iip1,jjp1,llm,nQ)
+      real dQ(iip1,jjp1,llm,nQ)
+
+      save ps_cum,masse_cum,flux_u_cum,flux_v_cum
+      save Q_cum,flux_uQ_cum,flux_vQ_cum
+
+c   champs de tansport en moyenne zonale
+      integer ntr,itr
+      parameter (ntr=5)
+
+      character*10 znom(ntr,nQ)
+      character*20 znoml(ntr,nQ)
+      character*10 zunites(ntr,nQ)
+      integer iave,itot,immc,itrs,istn
+      data iave,itot,immc,itrs,istn/1,2,3,4,5/
+      character*3 ctrs(ntr)
+      data ctrs/'  ','TOT','MMC','TRS','STN'/
+
+      real zvQ(jjm,llm,ntr,nQ),zvQtmp(jjm,llm)
+      real zavQ(jjm,ntr,nQ),psiQ(jjm,llm+1,nQ)
+      real zmasse(jjm,llm),zamasse(jjm)
+
+      real zv(jjm,llm),psi(jjm,llm+1)
+
+      integer i,j,l,iQ
+
+
+c   Initialisation du fichier contenant les moyennes zonales.
+c   ---------------------------------------------------------
+
+      character*10 infile
+
+      integer fileid
+      integer thoriid, zvertiid
+      save fileid
+
+      integer ndex3d(jjm*llm)
+
+C   Variables locales
+C
+      integer tau0
+      real zjulian
+      character*3 str
+      character*10 ctrac
+      integer ii,jj
+      integer zan, dayref
+C
+      real rlong(jjm),rlatg(jjm)
+
+
+
+c=====================================================================
+c   Initialisation
+c=====================================================================
+
+      time=time+dt_app
+      itau=itau+1
+
+      if (first) then
+
+
+        icum=0
+c       initialisation des fichiers
+        first=.false.
+c   ncum est la frequence de stokage en pas de temps
+        ncum=dt_cum/dt_app
+        if (abs(ncum*dt_app-dt_cum).gt.1.e-5*dt_app) then
+           print*,'Pb : le pas de cumule doit etre multiple du pas'
+           print*,'dt_app=',dt_app
+           print*,'dt_cum=',dt_cum
+           stop
+        endif
+
+        if (i_sortie.eq.1) then
+         file='dynzon'
+         call inigrads(ifile,1
+     s  ,0.,180./pi,0.,0.,jjm,rlatv,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,dt_cum,file,'dyn_zon ')
+        endif
+
+        nom(itemp)='T'
+        nom(igeop)='gz'
+        nom(iecin)='K'
+        nom(iang)='ang'
+        nom(iu)='u'
+        nom(iovap)='ovap'
+        nom(iun)='un'
+
+        unites(itemp)='K'
+        unites(igeop)='m2/s2'
+        unites(iecin)='m2/s2'
+        unites(iang)='ang'
+        unites(iu)='m/s'
+        unites(iovap)='kg/kg'
+        unites(iun)='un'
+
+
+c   Initialisation du fichier contenant les moyennes zonales.
+c   ---------------------------------------------------------
+
+      infile='dynzon'
+
+      zan = annee_ref
+      dayref = day_ref
+      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
+      tau0 = itau_dyn
+      
+      rlong=0.
+      rlatg=rlatv*180./pi
+       
+      call histbeg(infile, 1, rlong, jjm, rlatg,
+     .             1, 1, 1, jjm,
+     .             tau0, zjulian, dt_cum, thoriid, fileid)
+
+C
+C  Appel a histvert pour la grille verticale
+C
+      call histvert(fileid, 'presnivs', 'Niveaux sigma','mb',
+     .              llm, presnivs, zvertiid)
+C
+C  Appels a histdef pour la definition des variables a sauvegarder
+      do iQ=1,nQ
+         do itr=1,ntr
+            if(itr.eq.1) then
+               znom(itr,iQ)=nom(iQ)
+               znoml(itr,iQ)=nom(iQ)
+               zunites(itr,iQ)=unites(iQ)
+            else
+               znom(itr,iQ)=ctrs(itr)//'v'//nom(iQ)
+               znoml(itr,iQ)='transport : v * '//nom(iQ)//' '//ctrs(itr)
+               zunites(itr,iQ)='m/s * '//unites(iQ)
+            endif
+         enddo
+      enddo
+
+c   Declarations des champs avec dimension verticale
+      print*,'1HISTDEF'
+      do iQ=1,nQ
+         do itr=1,ntr
+            print*,'var ',itr,iQ
+     .      ,znom(itr,iQ),znoml(itr,iQ),zunites(itr,iQ)
+            call histdef(fileid,znom(itr,iQ),znoml(itr,iQ),
+     .        zunites(itr,iQ),1,jjm,thoriid,llm,1,llm,zvertiid,
+     .        32,'ave(X)',dt_cum,dt_cum)
+         enddo
+c   Declarations pour les fonctions de courant
+      print*,'2HISTDEF'
+          call histdef(fileid,'psi'//nom(iQ)
+     .      ,'stream fn. '//znoml(itot,iQ),
+     .      zunites(itot,iQ),1,jjm,thoriid,llm,1,llm,zvertiid,
+     .      32,'ave(X)',dt_cum,dt_cum)
+      enddo
+
+
+c   Declarations pour les champs de transport d'air
+      print*,'3HISTDEF'
+      call histdef(fileid, 'masse', 'masse',
+     .             'kg', 1, jjm, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'ave(X)', dt_cum, dt_cum)
+      call histdef(fileid, 'v', 'v',
+     .             'm/s', 1, jjm, thoriid, llm, 1, llm, zvertiid,
+     .             32, 'ave(X)', dt_cum, dt_cum)
+c   Declarations pour les fonctions de courant
+      print*,'4HISTDEF'
+          call histdef(fileid,'psi','stream fn. MMC ','mega t/s',
+     .      1,jjm,thoriid,llm,1,llm,zvertiid,
+     .      32,'ave(X)',dt_cum,dt_cum)
+
+
+c   Declaration des champs 1D de transport en latitude
+      print*,'5HISTDEF'
+      do iQ=1,nQ
+         do itr=2,ntr
+            call histdef(fileid,'a'//znom(itr,iQ),znoml(itr,iQ),
+     .        zunites(itr,iQ),1,jjm,thoriid,1,1,1,-99,
+     .        32,'ave(X)',dt_cum,dt_cum)
+         enddo
+      enddo
+
+
+      print*,'8HISTDEF'
+               CALL histend(fileid)
+
+
+      endif
+
+
+c=====================================================================
+c   Calcul des champs dynamiques
+c   ----------------------------
+
+c   énergie cinétique
+      CALL covcont(llm,ucov,vcov,ucont,vcont)
+      CALL enercin(vcov,ucov,vcont,ucont,ecin)
+
+c   moment cinétique
+      do l=1,llm
+         ang(:,:,l)=ucov(:,:,l)+constang(:,:)
+         unat(:,:,l)=ucont(:,:,l)*cu(:,:)
+      enddo
+
+      Q(:,:,:,itemp)=teta(:,:,:)*pk(:,:,:)/cpp
+      Q(:,:,:,igeop)=phi(:,:,:)
+      Q(:,:,:,iecin)=ecin(:,:,:)
+      Q(:,:,:,iang)=ang(:,:,:)
+      Q(:,:,:,iu)=unat(:,:,:)
+      Q(:,:,:,iovap)=q(:,:,:,1)
+      Q(:,:,:,iun)=1.
+
+
+c=====================================================================
+c   Cumul
+c=====================================================================
+c
+      if(icum.EQ.0) then
+         ps_cum=0.
+         masse_cum=0.
+         flux_u_cum=0.
+         flux_v_cum=0.
+         Q_cum=0.
+         flux_vQ_cum=0.
+         flux_uQ_cum=0.
+      endif
+
+c      print*,'dans bilan_dyn ',icum,'->',icum+1
+      icum=icum+1
+
+c   accumulation des flux de masse horizontaux
+      ps_cum=ps_cum+ps
+      masse_cum=masse_cum+masse
+      flux_u_cum=flux_u_cum+flux_u
+      flux_v_cum=flux_v_cum+flux_v
+      do iQ=1,nQ
+      Q_cum(:,:,:,iQ)=Q_cum(:,:,:,iQ)+Q(:,:,:,iQ)*masse(:,:,:)
+      enddo
+
+c=====================================================================
+c  FLUX ET TENDANCES
+c=====================================================================
+
+c   Flux longitudinal
+c   -----------------
+      do iQ=1,nQ
+         do l=1,llm
+            do j=1,jjp1
+               do i=1,iim
+                  flux_uQ_cum(i,j,l,iQ)=flux_uQ_cum(i,j,l,iQ)
+     s            +flux_u(i,j,l)*0.5*(Q(i,j,l,iQ)+Q(i+1,j,l,iQ))
+               enddo
+               flux_uQ_cum(iip1,j,l,iQ)=flux_uQ_cum(1,j,l,iQ)
+            enddo
+         enddo
+      enddo
+
+c    flux méridien
+c    -------------
+      do iQ=1,nQ
+         do l=1,llm
+            do j=1,jjm
+               do i=1,iip1
+                  flux_vQ_cum(i,j,l,iQ)=flux_vQ_cum(i,j,l,iQ)
+     s            +flux_v(i,j,l)*0.5*(Q(i,j,l,iQ)+Q(i,j+1,l,iQ))
+               enddo
+            enddo
+         enddo
+      enddo
+
+
+c    tendances
+c    ---------
+
+c   convergence horizontale
+      call  convflu(flux_uQ_cum,flux_vQ_cum,llm*nQ,dQ)
+
+c   calcul de la vitesse verticale
+      call convmas(flux_u_cum,flux_v_cum,convm)
+      CALL vitvert(convm,w)
+
+      do iQ=1,nQ
+         do l=1,llm-1
+            do j=1,jjp1
+               do i=1,iip1
+                  ww=-0.5*w(i,j,l+1)*(Q(i,j,l,iQ)+Q(i,j,l+1,iQ))
+                  dQ(i,j,l  ,iQ)=dQ(i,j,l  ,iQ)-ww
+                  dQ(i,j,l+1,iQ)=dQ(i,j,l+1,iQ)+ww
+               enddo
+            enddo
+         enddo
+      enddo
+ 
+c      print*,'Apres les calculs fait a chaque pas'
+c=====================================================================
+c   PAS DE TEMPS D'ECRITURE
+c=====================================================================
+      if (icum.eq.ncum) then
+c=====================================================================
+
+      print*,'Pas d ecriture'
+
+c   Normalisation
+      do iQ=1,nQ
+         Q_cum(:,:,:,iQ)=Q_cum(:,:,:,iQ)/masse_cum(:,:,:)
+      enddo
+      zz=1./float(ncum)
+      ps_cum=ps_cum*zz
+      masse_cum=masse_cum*zz
+      flux_u_cum=flux_u_cum*zz
+      flux_v_cum=flux_v_cum*zz
+      flux_uQ_cum=flux_uQ_cum*zz
+      flux_vQ_cum=flux_vQ_cum*zz
+      dQ=dQ*zz
+
+c     print*,'1OK'
+
+c   A retravailler eventuellement
+c   division de dQ par la masse pour revenir aux bonnes grandeurs
+      do iQ=1,nQ
+         dQ(:,:,:,iQ)=dQ(:,:,:,iQ)/masse_cum(:,:,:)
+      enddo
+ 
+c     print*,'2OK'
+c=====================================================================
+c   Transport méridien
+c=====================================================================
+
+c   cumul zonal des masses des mailles
+c   ----------------------------------
+      zv=0.
+      zmasse=0.
+      call massbar(masse_cum,massebx,masseby)
+      do l=1,llm
+         do j=1,jjm
+            do i=1,iim
+               zmasse(j,l)=zmasse(j,l)+masseby(i,j,l)
+               zv(j,l)=zv(j,l)+flux_v_cum(i,j,l)
+            enddo
+            zfactv(j,l)=cv(1,j)/zmasse(j,l)
+         enddo
+      enddo
+
+c     print*,'3OK'
+c   --------------------------------------------------------------
+c   calcul de la moyenne zonale du transport :
+c   ------------------------------------------
+c
+c                                     --
+c TOT : la circulation totale       [ vq ]
+c
+c                                      -     -
+c MMC : mean meridional circulation [ v ] [ q ]
+c
+c                                     ----      --       - -
+c TRS : transitoires                [ v'q'] = [ vq ] - [ v q ]
+c
+c                                     - * - *       - -       -     -
+c STT : stationaires                [ v   q   ] = [ v q ] - [ v ] [ q ]
+c
+c                                              - -
+c    on utilise aussi l'intermediaire TMP :  [ v q ]
+c
+c    la variable zfactv transforme un transport meridien cumule
+c    en kg/s * unte-du-champ-transporte en m/s * unite-du-champ-transporte
+c
+c   --------------------------------------------------------------
+
+
+c   ----------------------------------------
+c   Transport dans le plan latitude-altitude
+c   ----------------------------------------
+
+      zvQ=0.
+      psiQ=0.
+      do iQ=1,nQ
+         zvQtmp=0.
+         do l=1,llm
+            do j=1,jjm
+c              print*,'j,l,iQ=',j,l,iQ
+c   Calcul des moyennes zonales du transort total et de zvQtmp
+               do i=1,iim
+                  zvQ(j,l,itot,iQ)=zvQ(j,l,itot,iQ)
+     s                            +flux_vQ_cum(i,j,l,iQ)
+                  zqy=      0.5*(Q_cum(i,j,l,iQ)*masse_cum(i,j,l)+
+     s                           Q_cum(i,j+1,l,iQ)*masse_cum(i,j+1,l))
+                  zvQtmp(j,l)=zvQtmp(j,l)+flux_v_cum(i,j,l)*zqy
+     s             /(0.5*(masse_cum(i,j,l)+masse_cum(i,j+1,l)))
+                  zvQ(j,l,iave,iQ)=zvQ(j,l,iave,iQ)+zqy
+               enddo
+c              print*,'aOK'
+c   Decomposition
+               zvQ(j,l,iave,iQ)=zvQ(j,l,iave,iQ)/zmasse(j,l)
+               zvQ(j,l,itot,iQ)=zvQ(j,l,itot,iQ)*zfactv(j,l)
+               zvQtmp(j,l)=zvQtmp(j,l)*zfactv(j,l)
+               zvQ(j,l,immc,iQ)=zv(j,l)*zvQ(j,l,iave,iQ)*zfactv(j,l)
+               zvQ(j,l,itrs,iQ)=zvQ(j,l,itot,iQ)-zvQtmp(j,l)
+               zvQ(j,l,istn,iQ)=zvQtmp(j,l)-zvQ(j,l,immc,iQ)
+            enddo
+         enddo
+c   fonction de courant meridienne pour la quantite Q
+         do l=llm,1,-1
+            do j=1,jjm
+               psiQ(j,l,iQ)=psiQ(j,l+1,iQ)+zvQ(j,l,itot,iQ)
+            enddo
+         enddo
+      enddo
+
+c   fonction de courant pour la circulation meridienne moyenne
+      psi=0.
+      do l=llm,1,-1
+         do j=1,jjm
+            psi(j,l)=psi(j,l+1)+zv(j,l)
+            zv(j,l)=zv(j,l)*zfactv(j,l)
+         enddo
+      enddo
+
+c     print*,'4OK'
+c   sorties proprement dites
+      if (i_sortie.eq.1) then
+      do iQ=1,nQ
+         do itr=1,ntr
+            call histwrite(fileid,znom(itr,iQ),itau,zvQ(:,:,itr,iQ)
+     s      ,jjm*llm,ndex3d)
+         enddo
+         call histwrite(fileid,'psi'//nom(iQ),itau,psiQ(:,1:llm,iQ)
+     s      ,jjm*llm,ndex3d)
+      enddo
+
+      call histwrite(fileid,'masse',itau,zmasse
+     s   ,jjm*llm,ndex3d)
+      call histwrite(fileid,'v',itau,zv
+     s   ,jjm*llm,ndex3d)
+      psi=psi*1.e-9
+      call histwrite(fileid,'psi',itau,psi(:,1:llm),jjm*llm,ndex3d)
+
+      endif
+
+
+c   -----------------
+c   Moyenne verticale
+c   -----------------
+
+      zamasse=0.
+      do l=1,llm
+         zamasse(:)=zamasse(:)+zmasse(:,l)
+      enddo
+      zavQ=0.
+      do iQ=1,nQ
+         do itr=2,ntr
+            do l=1,llm
+               zavQ(:,itr,iQ)=zavQ(:,itr,iQ)+zvQ(:,l,itr,iQ)*zmasse(:,l)
+            enddo
+            zavQ(:,itr,iQ)=zavQ(:,itr,iQ)/zamasse(:)
+            call histwrite(fileid,'a'//znom(itr,iQ),itau,zavQ(:,itr,iQ)
+     s      ,jjm*llm,ndex3d)
+         enddo
+      enddo
+
+c     on doit pouvoir tracer systematiquement la fonction de courant.
+
+c=====================================================================
+c/////////////////////////////////////////////////////////////////////
+      icum=0                  !///////////////////////////////////////
+      endif ! icum.eq.ncum    !///////////////////////////////////////
+c/////////////////////////////////////////////////////////////////////
+c=====================================================================
+
+      return
+      end
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/calfis.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/calfis.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/calfis.F	(revision 497)
@@ -1,2 +1,5 @@
+C
+C $Header$
+C
       SUBROUTINE calfis(nq, lafin, rdayvrai,rday_ecri, heure,
      $            pucov,pvcov,pteta,pq,pmasse,pps,pp,ppk,pphis,pphi,
@@ -128,4 +131,5 @@
       REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqmx)
       REAL zdpsrf(ngridmx)
+      REAL zcufi(ngridmx),zcvfi(ngridmx)
 c
       REAL zsin(iim),zcos(iim),z1(iim)
@@ -141,4 +145,5 @@
       REAL latfi(ngridmx),lonfi(ngridmx)
       REAL airefi(ngridmx)
+      SAVE latfi, lonfi, airefi
 
       LOGICAL firstcal, debut
@@ -176,12 +181,18 @@
          latfi(1)=rlatu(1)
          lonfi(1)=0.
+         zcufi(1) = cu(1,1)
+         zcvfi(1) = cv(1,1)
          DO j=2,jjm
             DO i=1,iim
                latfi((j-2)*iim+1+i)= rlatu(j)
                lonfi((j-2)*iim+1+i)= rlonv(i)
+               zcufi((j-2)*iim+1+i) = cu(i,j)
+               zcvfi((j-2)*iim+1+i) = cv(i,j)
      	    ENDDO
          ENDDO
          latfi(ngridmx)= rlatu(jjp1)
          lonfi(ngridmx)= 0.
+         zcufi(ngridmx) = cu(1,jjp1)
+         zcvfi(ngridmx) = cv(1,jjm)
          CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
           PRINT*,'WARNING!!! vitesse verticale nulle dans la physique'
@@ -311,13 +322,13 @@
 c
       DO l=1,llm
-        pvervel(1,l)=pw(1,1,l)/apoln
+        pvervel(1,l)=pw(1,1,l) * g /apoln
         ig0=2
        DO j=2,jjm
            DO i = 1, iim
-              pvervel(ig0,l) = pw(i,j,l) * unsaire(i,j)
+              pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j)
               ig0 = ig0 + 1
            ENDDO
        ENDDO
-        pvervel(ig0,l)=pw(1,jjp1,l)/apols
+        pvervel(ig0,l)=pw(1,jjp1,l) * g /apols
       ENDDO
 
@@ -425,10 +436,11 @@
 
 
-      CALL physiq (ngridmx,llm,nq,debut,lafin,
-     ,   rdayvrai,rday_ecri,heure,dtphys,zplev,zplay,zphi,zphis,airefi,
-     ,             presnivs,clesphy0,  zufi, zvfi,ztfi, zqfi,  
-     ,             pcvgu, pcvgv, pcvgt, pcvgq, pvervel,
+      CALL physiq (ngridmx, llm, nq,
+     ,    debut, lafin, rdayvrai, rday_ecri, heure, dtphys,
+     ,    zplev, zplay, zphi, zphis, airefi, presnivs, clesphy0,
+     ,    zufi, zvfi, ztfi, zqfi,  
+     ,    pvervel, zcufi, zcvfi,
 C - sorties
-     s             zdufi, zdvfi, zdtfi, zdqfi,zdpsrf              )
+     s    zdufi, zdvfi, zdtfi, zdqfi,zdpsrf              )
 
 500   CONTINUE
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/coefpoly.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/coefpoly.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/coefpoly.F	(revision 497)
@@ -0,0 +1,38 @@
+c $Header$
+      SUBROUTINE coefpoly ( Xf1, Xf2, Xprim1, Xprim2, xtild1,xtild2 ,
+     ,                                          a0,a1,a2,a3         )
+      IMPLICIT NONE
+c
+c   ...  Auteur :   P. Le Van  ...
+c
+c
+c    Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
+c      satisfait aux 4 equations  suivantes :
+
+c    a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
+c    a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
+c               a1  +     2.*a2*xtild1 +     3.*a3*xtild1*xtild1 = Xprim1
+c               a1  +     2.*a2*xtild2 +     3.*a3*xtild2*xtild2 = Xprim2
+
+c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
+
+      REAL*8 Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi 
+      REAL*8 Xfout, Xprim
+      REAL*8 a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
+
+      xtil1car = xtild1 * xtild1
+      xtil2car = xtild2 * xtild2 
+
+      derr= 2. *(Xf2-Xf1)/( xtild1-xtild2)
+
+      x1x2car = ( xtild1-xtild2)*(xtild1-xtild2)
+
+      a3 = (derr + Xprim1+Xprim2 )/x1x2car
+      a2     = ( Xprim1 - Xprim2 + 3.* a3 * ( xtil2car-xtil1car ) )    /
+     /           (  2.* ( xtild1 - xtild2 )  )
+
+      a1     = Xprim1 -3.* a3 * xtil1car     -2.* a2 * xtild1
+      a0     =  Xf1 - a3 * xtild1* xtil1car -a2 * xtil1car - a1 *xtild1
+
+      RETURN
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/comvert.h
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/comvert.h	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/comvert.h	(revision 497)
@@ -3,5 +3,5 @@
 
       COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm) ,
-     ,               pa,preff,nivsigs(llm),nivsig(llmp1)
+     ,               pa,preff,nivsigs(llm),nivsig(llm+1)
 
       REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_dat2d.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_dat2d.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_dat2d.F	(revision 497)
@@ -0,0 +1,219 @@
+C
+C $Header$
+C
+      SUBROUTINE conf_dat2d( title,lons,lats,xd,yd,xf,yf,champd ,
+     ,                           interbar                        )
+c
+c     Auteur :  P. Le Van
+
+c    Ce s-pr. configure le champ de donnees 2D 'champd' de telle facon que
+c       qu'on ait     - pi    a    pi    en longitude
+c       et qu'on ait   pi/2.  a - pi/2.  en latitude
+c
+c      xd et yd  sont les longitudes et latitudes initiales
+c      xf et yf  sont les longitudes et latitudes en sortie , eventuellement
+c      modifiees pour etre configurees comme ci-dessus .
+
+      IMPLICIT NONE
+ 
+c    ***       Arguments en  entree      ***
+      INTEGER lons,lats
+      CHARACTER*25 title
+      REAL xd(lons),yd(lats)
+      LOGICAL interbar
+c
+c    ***       Arguments en  sortie      ***
+      REAL xf(lons),yf(lats)
+c
+c    ***  Arguments en entree et  sortie ***
+      REAL champd(lons,lats)
+
+c   ***     Variables  locales  ***
+c
+      REAL pi,pis2,depi
+      LOGICAL radianlon, invlon ,radianlat, invlat, alloc
+      REAL rlatmin,rlatmax,oldxd1
+      INTEGER i,j,ip180,ind
+
+      REAL, ALLOCATABLE :: xtemp(:) 
+      REAL, ALLOCATABLE :: ytemp(:) 
+      REAL, ALLOCATABLE :: champf(:,:)
+     
+c
+c      WRITE(6,*) ' conf_dat2d  pour la variable ', title
+
+      ALLOCATE( xtemp(lons) )
+      ALLOCATE( ytemp(lats) )
+      ALLOCATE( champf(lons,lats) )
+
+      DO i = 1, lons
+       xtemp(i) = xd(i)
+      ENDDO
+      DO j = 1, lats
+       ytemp(j) = yd(j)
+      ENDDO
+
+      pi   = 2. * ASIN(1.) 
+      pis2 = pi/2.
+      depi = 2. * pi
+
+            radianlon = .FALSE.
+      IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 )  THEN
+            radianlon = .TRUE.
+            invlon    = .FALSE.
+      ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
+            radianlon = .TRUE.
+            invlon    = .TRUE.
+      ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 )   THEN
+            radianlon = .FALSE.
+            invlon    = .FALSE.
+      ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 )   THEN
+            radianlon = .FALSE.
+            invlon    = .TRUE.
+      ELSE
+        WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
+     ,  , title
+      ENDIF
+
+      invlat = .FALSE.
+      
+      IF( ytemp(1).LT.ytemp(lats) ) THEN
+        invlat = .TRUE.
+      ENDIF
+
+      rlatmin = MIN( ytemp(1), ytemp(lats) )
+      rlatmax = MAX( ytemp(1), ytemp(lats) )
+      
+      IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
+             radianlat = .TRUE.
+      ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
+             radianlat = .FALSE.
+      ELSE
+        WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
+     ,  , title
+      ENDIF
+
+       IF( .NOT. radianlon )  THEN
+         DO i = 1, lons
+          xtemp(i) = xtemp(i) * pi/180.
+         ENDDO
+       ENDIF
+
+       IF( .NOT. radianlat )  THEN
+         DO j = 1, lats
+          ytemp(j) = ytemp(j) * pi/180.
+         ENDDO   
+       ENDIF
+
+
+        IF ( invlon )   THEN
+
+           DO j = 1, lats
+            DO i = 1,lons
+             champf(i,j) = champd(i,j)
+            ENDDO
+           ENDDO
+
+           DO i = 1 ,lons
+            xf(i) = xtemp(i)
+           ENDDO
+c
+c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
+c
+           DO i=1,lons
+            IF( xf(i).GT. pi )  THEN
+            GO TO 88
+            ENDIF
+           ENDDO
+
+88         CONTINUE
+c
+           ip180 = i
+
+           DO i = 1,lons
+            IF (xf(i).GT. pi)  THEN
+             xf(i) = xf(i) - depi
+            ENDIF
+           ENDDO
+
+           DO i= ip180,lons
+            ind = i-ip180 +1
+            xtemp(ind) = xf(i)
+           ENDDO
+
+           DO i= ind +1,lons
+            xtemp(i) = xf(i-ind)
+           ENDDO
+
+c   .....    on tourne les longitudes  pour  champf ....
+c
+           DO j = 1,lats
+
+             DO i = ip180,lons
+              ind  = i-ip180 +1
+              champd (ind,j) = champf (i,j)
+             ENDDO
+   
+             DO i= ind +1,lons
+              champd (i,j)  = champf (i-ind,j)
+             ENDDO
+
+           ENDDO
+
+
+        ENDIF
+c
+c    *****   fin  de   IF(invlon)   ****
+
+         IF ( invlat )    THEN
+
+           DO j = 1,lats
+            yf(j) = ytemp(j)
+           ENDDO
+
+           DO j = 1, lats
+             DO i = 1,lons
+              champf(i,j) = champd(i,j)
+             ENDDO
+           ENDDO
+
+           DO j = 1, lats
+              ytemp( lats-j+1 ) = yf(j)
+              DO i = 1, lons
+               champd (i,lats-j+1) = champf (i,j)
+              ENDDO
+           ENDDO
+
+
+         ENDIF
+
+c    *****  fin  de  IF(invlat)   ****
+
+c        
+      IF( interbar )  THEN
+        oldxd1 = xtemp(1)
+        DO i = 1, lons -1
+          xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
+        ENDDO
+          xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
+
+        DO j = 1, lats -1
+          ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
+        ENDDO
+
+      ENDIF
+c
+
+       DO i = 1, lons
+        xf(i) = xtemp(i)
+       ENDDO
+       DO j = 1, lats
+        yf(j) = ytemp(j)
+       ENDDO
+
+      DEALLOCATE(xtemp) 
+      DEALLOCATE(ytemp)
+      DEALLOCATE(champf)
+
+      RETURN
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_dat3d.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_dat3d.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_dat3d.F	(revision 497)
@@ -0,0 +1,294 @@
+C
+C $Header$
+C
+      SUBROUTINE conf_dat3d( title, lons,lats,levs,xd,yd,zd,xf,yf,zf,
+     ,                                 champd , interbar             )
+c
+c     Auteur : P. Le Van
+c
+c    Ce s-pr. configure le champ de donnees 3D 'champd' de telle facon 
+c       qu'on ait     - pi    a    pi    en longitude
+c       qu'on ait      pi/2.  a - pi/2.  en latitude
+c      et qu'on ait les niveaux verticaux variant du sol vers le ht de l'atmos.
+c           (     en Pascals   ) .
+c
+c      xd et yd  sont les longitudes et latitudes initiales
+c      zd  les pressions initiales
+c
+c      xf et yf  sont les longitudes et latitudes en sortie , eventuellement
+c       modifiees pour etre configurees comme ci-dessus .
+c      zf  les pressions en sortie
+c
+c      champd   en meme temps le champ initial et  final
+c
+c      interbar = .TRUE.  si on appelle l'interpo. barycentrique inter_barxy
+c          sinon , l'interpolation   grille_m  ( grid_atob ) .
+c
+
+      IMPLICIT NONE
+ 
+c    ***       Arguments en  entree      ***
+      CHARACTER*(*) :: title
+      INTEGER lons, lats, levs
+      REAL xd(lons), yd(lats), zd(levs)
+      LOGICAL interbar
+c
+c    ***       Arguments en  sortie      ***
+      REAL xf(lons), yf(lats), zf(levs)
+
+c    ***  Arguments en entree et  sortie ***
+      REAL  champd(lons,lats,levs)
+
+c    ***  Variables locales  ***
+c
+      REAL pi,pis2,depi,presmax
+      LOGICAL radianlon, invlon ,radianlat, invlat, invlev, alloc
+      REAL rlatmin,rlatmax,oldxd1
+      INTEGER i,j,ip180,ind,l
+
+      REAL, ALLOCATABLE :: xtemp(:)
+      REAL, ALLOCATABLE :: ytemp(:)
+      REAL, ALLOCATABLE :: ztemp(:)
+      REAL, ALLOCATABLE :: champf(:,:,:)
+     
+
+c      WRITE(6,*) '  Conf_dat3d  pour  ',title
+
+      ALLOCATE(xtemp(lons))
+      ALLOCATE(ytemp(lats))
+      ALLOCATE(ztemp(levs))
+
+      DO i = 1, lons
+       xtemp(i) = xd(i)
+      ENDDO
+      DO j = 1, lats
+       ytemp(j) = yd(j)
+      ENDDO
+      DO l = 1, levs
+       ztemp(l) = zd(l)
+      ENDDO
+
+      pi   = 2. * ASIN(1.) 
+      pis2 = pi/2.
+      depi = 2. * pi
+
+      IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 )  THEN
+            radianlon = .TRUE.
+            invlon    = .FALSE.
+      ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
+            radianlon = .TRUE.
+            invlon    = .TRUE.
+      ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 )   THEN
+            radianlon = .FALSE.
+            invlon    = .FALSE.
+      ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 )   THEN
+            radianlon = .FALSE.
+            invlon    = .TRUE.
+      ELSE
+        WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
+     ,  , title
+      ENDIF
+
+      invlat = .FALSE.
+      
+      IF( ytemp(1).LT.ytemp(lats) ) THEN
+        invlat = .TRUE.
+      ENDIF
+
+      rlatmin = MIN( ytemp(1), ytemp(lats) )
+      rlatmax = MAX( ytemp(1), ytemp(lats) )
+      
+      IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
+             radianlat = .TRUE.
+      ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
+             radianlat = .FALSE.
+      ELSE
+        WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
+     ,  , title
+      ENDIF
+
+       IF( .NOT. radianlon )  THEN
+         DO i = 1, lons
+          xtemp(i) = xtemp(i) * pi/180.
+         ENDDO
+       ENDIF
+
+       IF( .NOT. radianlat )  THEN
+         DO j = 1, lats
+          ytemp(j) = ytemp(j) * pi/180.
+         ENDDO   
+       ENDIF
+
+
+        alloc =.FALSE.
+
+        IF ( invlon )   THEN
+
+            ALLOCATE(champf(lons,lats,levs))
+            alloc = .TRUE.
+
+            DO i = 1 ,lons
+             xf(i) = xtemp(i)
+            ENDDO
+
+            DO l = 1, levs
+             DO j = 1, lats
+              DO i= 1, lons
+               champf (i,j,l)  = champd (i,j,l)
+              ENDDO
+             ENDDO
+            ENDDO
+c
+c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
+c
+            DO i=1,lons
+             IF( xf(i).GT. pi )  THEN
+              GO TO 88
+             ENDIF
+            ENDDO
+
+88          CONTINUE
+c
+            ip180 = i
+
+            DO i = 1,lons
+             IF (xf(i).GT. pi)  THEN
+              xf(i) = xf(i) - depi
+             ENDIF
+            ENDDO
+
+            DO i= ip180,lons
+             ind = i-ip180 +1
+             xtemp(ind) = xf(i)
+            ENDDO
+
+            DO i= ind +1,lons
+             xtemp(i) = xf(i-ind)
+            ENDDO
+
+c   .....    on tourne les longitudes  pour champf  ....
+c
+            DO l = 1,levs
+              DO j = 1,lats
+               DO i = ip180,lons
+                ind  = i-ip180 +1
+                champd (ind,j,l) = champf (i,j,l)
+               ENDDO
+   
+               DO i= ind +1,lons
+                champd (i,j,l)  = champf (i-ind,j,l)
+               ENDDO
+              ENDDO
+            ENDDO
+
+        ENDIF
+c
+c    *****   fin  de   IF(invlon)   ****
+         
+         IF ( invlat )    THEN
+
+           IF(.NOT.alloc)  THEN 
+            ALLOCATE(champf(lons,lats,levs))
+            alloc = .TRUE.
+           ENDIF
+
+           DO j = 1, lats
+            yf(j) = ytemp(j)
+           ENDDO
+         
+           DO l = 1,levs
+            DO j = 1, lats
+             DO i = 1,lons
+              champf(i,j,l) = champd(i,j,l)
+             ENDDO
+            ENDDO
+
+            DO j = 1, lats
+              ytemp( lats-j+1 ) = yf(j)
+              DO i = 1, lons
+               champd (i,lats-j+1,l) = champf (i,j,l)
+              ENDDO
+            ENDDO
+          ENDDO
+
+
+         ENDIF
+
+c    *****  fin  de  IF(invlat)   ****
+c
+c
+      IF( interbar )  THEN
+        oldxd1 = xtemp(1)
+        DO i = 1, lons -1
+          xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
+        ENDDO
+          xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
+
+        DO j = 1, lats -1
+          ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
+        ENDDO
+      ENDIF
+c
+
+      invlev = .FALSE.
+      IF( ztemp(1).LT.ztemp(levs) )  invlev = .TRUE.
+
+      presmax = MAX( ztemp(1), ztemp(levs) )
+      IF( presmax.LT.1200. ) THEN
+         DO l = 1,levs
+           ztemp(l) = ztemp(l) * 100.
+         ENDDO
+      ENDIF
+
+      IF( invlev )  THEN
+
+          IF(.NOT.alloc)  THEN
+            ALLOCATE(champf(lons,lats,levs))
+            alloc = .TRUE.
+          ENDIF
+
+          DO l = 1,levs
+            zf(l) = ztemp(l)
+          ENDDO
+
+          DO l = 1,levs
+            DO j = 1, lats
+             DO i = 1,lons
+              champf(i,j,l) = champd(i,j,l)
+             ENDDO
+            ENDDO
+          ENDDO
+
+          DO l = 1,levs
+            ztemp(levs+1-l) = zf(l)
+          ENDDO
+
+          DO l = 1,levs
+            DO j = 1, lats
+             DO i = 1,lons
+              champd(i,j,levs+1-l) = champf(i,j,l)
+             ENDDO
+            ENDDO
+          ENDDO
+
+
+      ENDIF
+
+         IF(alloc)  DEALLOCATE(champf)
+
+         DO i = 1, lons
+           xf(i) = xtemp(i)
+         ENDDO
+         DO j = 1, lats
+           yf(j) = ytemp(j)
+         ENDDO
+         DO l = 1, levs
+           zf(l) = ztemp(l)
+         ENDDO
+
+      DEALLOCATE(xtemp)
+      DEALLOCATE(ytemp)
+      DEALLOCATE(ztemp)
+
+      RETURN
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_gcm.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_gcm.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/conf_gcm.F	(revision 497)
@@ -0,0 +1,733 @@
+c
+c $Header$
+c
+      SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
+c
+      use IOIPSL
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c     Auteurs :   L. Fairhead , P. Le Van  .
+c
+c     Arguments :
+c
+c     tapedef   :
+c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
+c     -metres  du zoom  avec  celles lues sur le fichier start .
+c      clesphy0 :  sortie  .
+c
+       LOGICAL etatinit
+       INTEGER tapedef
+
+       INTEGER        longcles
+       PARAMETER(     longcles = 20 )
+       REAL clesphy0( longcles )
+c
+c   Declarations :
+c   --------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "control.h"
+#include "logic.h"
+#include "serre.h"
+#include "comdissnew.h"
+#include "clesphys.h"
+c
+c
+c   local:
+c   ------
+
+      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
+      INTEGER   tapeout
+      REAL clonn,clatt,grossismxx,grossismyy
+      REAL dzoomxx,dzoomyy, tauxx,tauyy
+      LOGICAL  fxyhypbb, ysinuss
+      INTEGER i
+      
+c
+c  -------------------------------------------------------------------
+c
+c       .........     Version  du 29/04/97       ..........
+c
+c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
+c      tetatemp   ajoutes  pour la dissipation   .
+c
+c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb ** 
+c
+c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
+c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
+c
+c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
+c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
+c                de limit.dat ( dic)                        ...........
+c           Sinon  etatinit = . FALSE .
+c
+c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
+c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
+c   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
+c    lectba .  
+c   Ces parmetres definissant entre autres la grille et doivent etre
+c   pareils et coherents , sinon il y aura  divergence du gcm .
+c
+c-----------------------------------------------------------------------
+c   initialisations:
+c   ----------------
+
+      tapeout = 6
+
+c-----------------------------------------------------------------------
+c  Parametres de controle du run:
+c-----------------------------------------------------------------------
+
+!Config  Key  = dayref
+!Config  Desc = Jour de l'etat initial
+!Config  Def  = 1
+!Config  Help = Jour de l'etat initial ( = 350  si 20 Decembre ,
+!Config         par expl. ,comme ici ) ... A completer
+      dayref=1
+      CALL getin('dayref', dayref)
+
+!Config  Key  = anneeref
+!Config  Desc = Annee de l'etat initial
+!Config  Def  = 1998
+!Config  Help = Annee de l'etat  initial 
+!Config         (   avec  4  chiffres   ) ... A completer
+      anneeref = 1998
+      CALL getin('anneeref',anneeref)
+
+!Config  Key  = raz_date
+!Config  Desc = Remise a zero de la date initiale
+!Config  Def  = 0 (pas de remise a zero)
+!Config  Help = Remise a zero de la date initiale 
+!Config         0 pas de remise a zero, on garde la date du fichier restart
+!Config         1 prise en compte de la date de gcm.def avec remise a zero
+!Config         des compteurs de pas de temps
+      raz_date = 0
+      CALL getin('raz_date', raz_date)
+
+!Config  Key  = nday
+!Config  Desc = Nombre de jours d'integration
+!Config  Def  = 10
+!Config  Help = Nombre de jours d'integration
+!Config         ... On pourait aussi permettre des mois ou des annees !
+      nday = 10
+      CALL getin('nday',nday)
+
+!Config  Key  = day_step
+!Config  Desc = nombre de pas par jour
+!Config  Def  = 240 
+!Config  Help = nombre de pas par jour (multiple de iperiod) (
+!Config          ici pour  dt = 1 min ) 
+       day_step = 240 
+       CALL getin('day_step',day_step)
+
+!Config  Key  = iperiod
+!Config  Desc = periode pour le pas Matsuno 
+!Config  Def  = 5
+!Config  Help = periode pour le pas Matsuno (en pas de temps) 
+       iperiod = 5
+       CALL getin('iperiod',iperiod)
+
+
+!Config  Key  = iconser
+!Config  Desc = periode de sortie des variables de controle
+!Config  Def  = 240  
+!Config  Help = periode de sortie des variables de controle
+!Config         (En pas de temps)
+       iconser = 240  
+       CALL getin('iconser', iconser)
+
+!Config  Key  = iecri
+!Config  Desc = periode d'ecriture du fichier histoire
+!Config  Def  = 1
+!Config  Help = periode d'ecriture du fichier histoire (en jour) 
+       iecri = 1
+       CALL getin('iecri',iecri)
+
+
+!Config  Key  = periodav
+!Config  Desc = periode de stockage fichier histmoy
+!Config  Def  = 1
+!Config  Help = periode de stockage fichier histmoy (en jour) 
+       periodav = 1.
+       CALL getin('periodav',periodav)
+
+!Config  Key  = idissip
+!Config  Desc = periode de la dissipation 
+!Config  Def  = 10
+!Config  Help = periode de la dissipation 
+!Config         (en pas) ... a completer !
+       idissip = 10
+       CALL getin('idissip',idissip)
+
+ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
+ccc
+
+!Config  Key  = lstardis
+!Config  Desc = choix de l'operateur de dissipation
+!Config  Def  = y
+!Config  Help = choix de l'operateur de dissipation
+!Config         'y' si on veut star et 'n' si on veut non-start !
+!Config         Moi y en a pas comprendre ! 
+       lstardis = .TRUE.
+       CALL getin('lstardis',lstardis)
+
+
+!Config  Key  = nitergdiv
+!Config  Desc = Nombre d'iteration de gradiv
+!Config  Def  = 1
+!Config  Help = nombre d'iterations de l'operateur de dissipation 
+!Config         gradiv
+       nitergdiv = 1
+       CALL getin('nitergdiv',nitergdiv)
+
+!Config  Key  = nitergrot
+!Config  Desc = nombre d'iterations de nxgradrot
+!Config  Def  = 2
+!Config  Help = nombre d'iterations de l'operateur de dissipation  
+!Config         nxgradrot
+       nitergrot = 2
+       CALL getin('nitergrot',nitergrot)
+
+
+!Config  Key  = niterh
+!Config  Desc = nombre d'iterations de divgrad
+!Config  Def  = 2
+!Config  Help = nombre d'iterations de l'operateur de dissipation
+!Config         divgrad
+       niterh = 2
+       CALL getin('niterh',niterh)
+
+
+!Config  Key  = tetagdiv
+!Config  Desc = temps de dissipation pour div
+!Config  Def  = 7200
+!Config  Help = temps de dissipation des plus petites longeur 
+!Config         d'ondes pour u,v (gradiv)
+       tetagdiv = 7200.
+       CALL getin('tetagdiv',tetagdiv)
+
+!Config  Key  = tetagrot
+!Config  Desc = temps de dissipation pour grad
+!Config  Def  = 7200
+!Config  Help = temps de dissipation des plus petites longeur 
+!Config         d'ondes pour u,v (nxgradrot)
+       tetagrot = 7200.
+       CALL getin('tetagrot',tetagrot)
+
+!Config  Key  = tetatemp 
+!Config  Desc = temps de dissipation pour h
+!Config  Def  = 7200
+!Config  Help =  temps de dissipation des plus petites longeur 
+!Config         d'ondes pour h (divgrad)   
+       tetatemp  = 7200.
+       CALL getin('tetatemp',tetatemp )
+
+!Config  Key  = coefdis
+!Config  Desc = coefficient pour gamdissip
+!Config  Def  = 0
+!Config  Help = coefficient pour gamdissip  
+       coefdis = 0.
+       CALL getin('coefdis',coefdis)
+
+!Config  Key  = purmats
+!Config  Desc = Schema d'integration
+!Config  Def  = n
+!Config  Help = Choix du schema d'integration temporel.
+!Config         y = pure Matsuno sinon c'est du Matsuno-leapfrog
+       purmats = .FALSE.
+       CALL getin('purmats',purmats)
+
+c    ...............................................................
+
+!Config  Key  = physic
+!Config  Desc = Avec ls physique 
+!Config  Def  = y
+!Config  Help = Permet de faire tourner le modele sans 
+!Config         physique.
+       physic = .TRUE.
+       CALL getin('physic',physic)
+
+
+!Config  Key  =  iphysiq
+!Config  Desc = Periode de la physique
+!Config  Def  = 5
+!Config  Help = Periode de la physique en pas de temps de la dynamique.
+       iphysiq = 5
+       CALL getin('iphysiq', iphysiq)
+
+ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
+c
+
+!Config  Key  = ecritphy
+!Config  Desc = Frequence d'ecriture de la physique
+!Config  Def  = 1
+!Config  Help = frequence  de l'ecriture du fichier histphy
+!Config         en jours.
+       ecritphy = 1
+       CALL getin('ecritphy',ecritphy)
+
+!Config  Key  = cycle_diurne
+!Config  Desc = Cycle ddiurne
+!Config  Def  = y
+!Config  Help = Cette option permet d'eteidre le cycle diurne.
+!Config         Peut etre util pour accelerer le code !
+       cycle_diurne = .TRUE.
+       CALL getin('cycle_diurne',cycle_diurne)
+
+!Config  Key  = soil_model
+!Config  Desc = Modele de sol
+!Config  Def  = y
+!Config  Help = Choix du modele de sol (Thermique ?)
+!Config         Option qui pourait un string afin de pouvoir
+!Config         plus de choix ! Ou meme une liste d'options !
+       soil_model = .TRUE.
+       CALL getin('soil_model',soil_model)
+
+!Config  Key  = new_oliq
+!Config  Desc = Nouvelle eau liquide
+!Config  Def  = y
+!Config  Help = Permet de mettre en route la
+!Config         nouvelle parametrisation de l'eau liquide !
+       new_oliq = .TRUE.
+       CALL getin('new_oliq',new_oliq)
+
+!Config  Key  = ok_orodr
+!Config  Desc = Orodr ???
+!Config  Def  = y
+!Config  Help = Y en a pas comprendre !
+!Config         
+       ok_orodr = .TRUE.
+       CALL getin('ok_orodr',ok_orodr)
+
+!Config  Key  =  ok_orolf
+!Config  Desc = Orolf ??
+!Config  Def  = y
+!Config  Help = Connais pas !
+       ok_orolf = .TRUE.
+       CALL getin('ok_orolf', ok_orolf)
+
+!Config  Key  = ok_limitvrai
+!Config  Desc = Force la lecture de la bonne annee
+!Config  Def  = n
+!Config  Help = On peut forcer le modele a lire le
+!Config         fichier SST de la bonne annee. C'est une tres bonne
+!Config         idee, pourquoi ne pas mettre toujours a y ???
+       ok_limitvrai = .FALSE.
+       CALL getin('ok_limitvrai',ok_limitvrai)
+
+!Config  Key  = nbapp_rad
+!Config  Desc = Frequence d'appel au rayonnement
+!Config  Def  = 12
+!Config  Help = Nombre  d'appels des routines de rayonnements
+!Config         par jour.
+       nbapp_rad = 12
+       CALL getin('nbapp_rad',nbapp_rad)
+
+!Config  Key  = iflag_con
+!Config  Desc = Flag de convection
+!Config  Def  = 2
+!Config  Help = Flag  pour la convection les options suivantes existent :
+!Config         1 pour LMD,
+!Config         2 pour Tiedtke,
+!Config         3 pour CCM(NCAR)  
+       iflag_con = 2
+       CALL getin('iflag_con',iflag_con)
+
+      DO i = 1, longcles
+       clesphy0(i) = 0.
+      ENDDO
+                          clesphy0(1) = FLOAT( iflag_con )
+                          clesphy0(2) = FLOAT( nbapp_rad )
+
+       IF( cycle_diurne  ) clesphy0(3) =  1.
+       IF(   soil_model  ) clesphy0(4) =  1.
+       IF(     new_oliq  ) clesphy0(5) =  1.
+       IF(     ok_orodr  ) clesphy0(6) =  1.
+       IF(     ok_orolf  ) clesphy0(7) =  1.
+       IF(  ok_limitvrai ) clesphy0(8) =  1.
+
+
+ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
+c     .........   (  modif  le 17/04/96 )   .........
+c
+      IF( etatinit ) GO TO 100
+
+!Config  Key  = clon
+!Config  Desc = centre du zoom, longitude
+!Config  Def  = 0
+!Config  Help = longitude en degres du centre 
+!Config         du zoom
+       clonn = 0.
+       CALL getin('clon',clonn)
+
+!Config  Key  = clat
+!Config  Desc = centre du zoom, latitude
+!Config  Def  = 0
+!Config  Help = latitude en degres du centre du zoom
+!Config         
+       clatt = 0.
+       CALL getin('clat',clatt)
+
+c
+c
+      IF( ABS(clat - clatt).GE. 0.001 )  THEN
+        PRINT *,' La valeur de clat passee par run.def est differente de 
+     *  celle lue sur le fichier  start '
+        STOP
+      ENDIF
+
+!Config  Key  = grossismx 
+!Config  Desc = zoom en longitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la longitude
+       grossismxx = 1.0
+       CALL getin('grossismx',grossismxx)
+
+
+      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
+        PRINT *,' La valeur de grossismx passee par run.def est differente  
+     *  de celle lue sur le fichier  start '
+        STOP
+      ENDIF
+
+!Config  Key  = grossismy
+!Config  Desc = zoom en latitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la latitude
+       grossismyy = 1.0
+       CALL getin('grossismy',grossismyy)
+
+      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
+        PRINT *,' La valeur de grossismy passee par run.def est differen
+     * te de celle lue sur le fichier  start '
+        STOP
+      ENDIF
+      
+      IF( grossismx.LT.1. )  THEN
+        PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+         STOP
+      ELSE
+         alphax = 1. - 1./ grossismx
+      ENDIF
+
+
+      IF( grossismy.LT.1. )  THEN
+        PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+         STOP
+      ELSE
+         alphay = 1. - 1./ grossismy
+      ENDIF
+
+      PRINT *,' alphax alphay defrun ',alphax,alphay
+c
+c    alphax et alphay sont les anciennes formulat. des grossissements
+c
+c
+
+!Config  Key  = fxyhypb
+!Config  Desc = Fonction  hyperbolique
+!Config  Def  = y
+!Config  Help = Fonction  f(y)  hyperbolique  si = .true.  
+!Config         sinon  sinusoidale
+       fxyhypbb = .TRUE.
+       CALL getin('fxyhypb',fxyhypbb)
+
+      IF( .NOT.fxyhypb )  THEN
+           IF( fxyhypbb )     THEN
+              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+              PRINT *,' *** fxyhypb lu sur le fichier start est F ',
+     *       'alors  qu il est  T  sur  run.def  ***'
+              STOP
+           ENDIF
+      ELSE
+           IF( .NOT.fxyhypbb )   THEN
+              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+              PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
+     *        'alors  qu il est  F  sur  run.def  ****  '
+              STOP
+           ENDIF
+      ENDIF
+c
+!Config  Key  = dzoomx
+!Config  Desc = extension en longitude
+!Config  Def  = 0
+!Config  Help = extension en longitude  de la zone du zoom  
+!Config         ( fraction de la zone totale)
+       dzoomxx = 0.0
+       CALL getin('dzoomx',dzoomxx)
+
+      IF( fxyhypb )  THEN
+       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
+        PRINT *,' La valeur de dzoomx passee par run.def est differente 
+     *  de celle lue sur le fichier  start '
+        STOP
+       ENDIF
+      ENDIF
+
+!Config  Key  = dzoomy
+!Config  Desc = extension en latitude
+!Config  Def  = 0
+!Config  Help = extension en latitude de la zone  du zoom  
+!Config         ( fraction de la zone totale)
+       dzoomyy = 0.0
+       CALL getin('dzoomy',dzoomyy)
+
+      IF( fxyhypb )  THEN
+       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
+        PRINT *,' La valeur de dzoomy passee par run.def est differente 
+     * de celle lue sur le fichier  start '
+        STOP
+       ENDIF
+      ENDIF
+      
+!Config  Key  = taux
+!Config  Desc = raideur du zoom en  X
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  X
+       tauxx = 3.0
+       CALL getin('taux',tauxx)
+
+      IF( fxyhypb )  THEN
+       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
+        PRINT *,' La valeur de taux passee par run.def est differente
+     * de celle lue sur le fichier  start '
+        STOP
+       ENDIF
+      ENDIF
+
+!Config  Key  = tauyy
+!Config  Desc = raideur du zoom en  Y
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  Y
+       tauyy = 3.0
+       CALL getin('tauy',tauyy)
+
+      IF( fxyhypb )  THEN
+       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
+        PRINT *,' La valeur de tauy passee par run.def est differente
+     * de celle lue sur le fichier  start '
+        STOP
+       ENDIF
+      ENDIF
+
+cc
+      IF( .NOT.fxyhypb  )  THEN
+
+!Config  Key  = ysinus
+!Config  IF   = !fxyhypb
+!Config  Desc = Fonction en Sinus
+!Config  Def  = y
+!Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true. 
+!Config         sinon y = latit.
+       ysinuss = .TRUE.
+       CALL getin('ysinus',ysinuss)
+
+        IF( .NOT.ysinus )  THEN
+           IF( ysinuss )     THEN
+              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+              PRINT *,' *** ysinus lu sur le fichier start est F ',
+     *       'alors  qu il est  T  sur  run.def  ***'
+              STOP
+           ENDIF
+        ELSE
+           IF( .NOT.ysinuss )   THEN
+              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
+              PRINT *,' ***  ysinus lu sur le fichier start est T ',
+     *        'alors  qu il est  F  sur  run.def  ****  '
+              STOP
+           ENDIF
+        ENDIF
+      ENDIF
+c
+
+      write(tapeout,*)' #########################################'
+      write(tapeout,*)' Configuration des parametres du gcm: '
+      write(tapeout,*)' dayref = ', dayref
+      write(tapeout,*)' anneeref = ', anneeref
+      write(tapeout,*)' nday = ', nday
+      write(tapeout,*)' day_step = ', day_step
+      write(tapeout,*)' iperiod = ', iperiod
+      write(tapeout,*)' iconser = ', iconser
+      write(tapeout,*)' iecri = ', iecri
+      write(tapeout,*)' periodav = ', periodav 
+      write(tapeout,*)' idissip = ', idissip
+      write(tapeout,*)' lstardis = ', lstardis
+      write(tapeout,*)' nitergdiv = ', nitergdiv
+      write(tapeout,*)' nitergrot = ', nitergrot
+      write(tapeout,*)' niterh = ', niterh
+      write(tapeout,*)' tetagdiv = ', tetagdiv
+      write(tapeout,*)' tetagrot = ', tetagrot
+      write(tapeout,*)' tetatemp = ', tetatemp
+      write(tapeout,*)' coefdis = ', coefdis
+      write(tapeout,*)' purmats = ', purmats
+      write(tapeout,*)' physic = ', physic
+      write(tapeout,*)' iphysiq = ', iphysiq
+      write(tapeout,*)' ecritphy = ', ecritphy
+      write(tapeout,*)' cycle_diurne = ', cycle_diurne
+      write(tapeout,*)' soil_model = ', soil_model
+      write(tapeout,*)' new_oliq = ', new_oliq
+      write(tapeout,*)' ok_orodr = ', ok_orodr
+      write(tapeout,*)' ok_orolf = ', ok_orolf
+      write(tapeout,*)' ok_limitvrai = ', ok_limitvrai
+      write(tapeout,*)' nbapp_rad = ', nbapp_rad
+      write(tapeout,*)' iflag_con = ', iflag_con
+      write(tapeout,*)' clonn = ', clonn 
+      write(tapeout,*)' clatt = ', clatt
+      write(tapeout,*)' grossismx = ', grossismx
+      write(tapeout,*)' grossismy = ', grossismy
+      write(tapeout,*)' fxyhypbb = ', fxyhypbb
+      write(tapeout,*)' dzoomxx = ', dzoomxx
+      write(tapeout,*)' dzoomy = ', dzoomyy
+      write(tapeout,*)' tauxx = ', tauxx
+      write(tapeout,*)' tauyy = ', tauyy
+
+      RETURN
+c   ...............................................
+c
+100   CONTINUE
+!Config  Key  = clon
+!Config  Desc = centre du zoom, longitude
+!Config  Def  = 0
+!Config  Help = longitude en degres du centre 
+!Config         du zoom
+       clon = 0.
+       CALL getin('clon',clon)
+
+!Config  Key  = clat
+!Config  Desc = centre du zoom, latitude
+!Config  Def  = 0
+!Config  Help = latitude en degres du centre du zoom
+!Config         
+       clat = 0.
+       CALL getin('clat',clat)
+
+!Config  Key  = grossismx 
+!Config  Desc = zoom en longitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la longitude
+       grossismx = 1.0
+       CALL getin('grossismx',grossismx)
+
+!Config  Key  = grossismy
+!Config  Desc = zoom en latitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la latitude
+       grossismy = 1.0
+       CALL getin('grossismy',grossismy)
+
+      IF( grossismx.LT.1. )  THEN
+        PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+         STOP
+      ELSE
+         alphax = 1. - 1./ grossismx
+      ENDIF
+
+
+      IF( grossismy.LT.1. )  THEN
+        PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+         STOP
+      ELSE
+         alphay = 1. - 1./ grossismy
+      ENDIF
+
+      PRINT *,' alphax alphay defrun ',alphax,alphay
+c
+c    alphax et alphay sont les anciennes formulat. des grossissements
+c
+c
+
+!Config  Key  = fxyhypb
+!Config  Desc = Fonction  hyperbolique
+!Config  Def  = y
+!Config  Help = Fonction  f(y)  hyperbolique  si = .true.  
+!Config         sinon  sinusoidale
+       fxyhypb = .TRUE.
+       CALL getin('fxyhypb',fxyhypb)
+
+!Config  Key  = dzoomx
+!Config  Desc = extension en longitude
+!Config  Def  = 0
+!Config  Help = extension en longitude  de la zone du zoom  
+!Config         ( fraction de la zone totale)
+       dzoomx = 0.0
+       CALL getin('dzoomx',dzoomx)
+
+!Config  Key  = dzoomy
+!Config  Desc = extension en latitude
+!Config  Def  = 0
+!Config  Help = extension en latitude de la zone  du zoom  
+!Config         ( fraction de la zone totale)
+       dzoomy = 0.0
+       CALL getin('dzoomy',dzoomy)
+
+!Config  Key  = taux
+!Config  Desc = raideur du zoom en  X
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  X
+       taux = 3.0
+       CALL getin('taux',taux)
+
+!Config  Key  = tauy
+!Config  Desc = raideur du zoom en  Y
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  Y
+       tauy = 3.0
+       CALL getin('tauy',tauy)
+
+!Config  Key  = ysinus
+!Config  IF   = !fxyhypb
+!Config  Desc = Fonction en Sinus
+!Config  Def  = y
+!Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true. 
+!Config         sinon y = latit.
+       ysinus = .TRUE.
+       CALL getin('ysinus',ysinus)
+c
+
+      write(tapeout,*)' #########################################'
+      write(tapeout,*)' Configuration des parametres du gcm: '
+      write(tapeout,*)' dayref = ', dayref
+      write(tapeout,*)' anneeref = ', anneeref
+      write(tapeout,*)' nday = ', nday
+      write(tapeout,*)' day_step = ', day_step
+      write(tapeout,*)' iperiod = ', iperiod
+      write(tapeout,*)' iconser = ', iconser
+      write(tapeout,*)' iecri = ', iecri
+      write(tapeout,*)' periodav = ', periodav 
+      write(tapeout,*)' idissip = ', idissip
+      write(tapeout,*)' lstardis = ', lstardis
+      write(tapeout,*)' nitergdiv = ', nitergdiv
+      write(tapeout,*)' nitergrot = ', nitergrot
+      write(tapeout,*)' niterh = ', niterh
+      write(tapeout,*)' tetagdiv = ', tetagdiv
+      write(tapeout,*)' tetagrot = ', tetagrot
+      write(tapeout,*)' tetatemp = ', tetatemp
+      write(tapeout,*)' coefdis = ', coefdis
+      write(tapeout,*)' purmats = ', purmats
+      write(tapeout,*)' physic = ', physic
+      write(tapeout,*)' iphysiq = ', iphysiq
+      write(tapeout,*)' ecritphy = ', ecritphy
+      write(tapeout,*)' cycle_diurne = ', cycle_diurne
+      write(tapeout,*)' soil_model = ', soil_model
+      write(tapeout,*)' new_oliq = ', new_oliq
+      write(tapeout,*)' ok_orodr = ', ok_orodr
+      write(tapeout,*)' ok_orolf = ', ok_orolf
+      write(tapeout,*)' ok_limitvrai = ', ok_limitvrai
+      write(tapeout,*)' nbapp_rad = ', nbapp_rad
+      write(tapeout,*)' iflag_con = ', iflag_con
+      write(tapeout,*)' clonn = ', clonn 
+      write(tapeout,*)' clatt = ', clatt
+      write(tapeout,*)' grossismx = ', grossismx
+      write(tapeout,*)' grossismy = ', grossismy
+      write(tapeout,*)' fxyhypbb = ', fxyhypbb
+      write(tapeout,*)' dzoomx = ', dzoomx
+      write(tapeout,*)' dzoomy = ', dzoomy
+      write(tapeout,*)' taux = ', taux
+      write(tapeout,*)' tauy = ', tauy
+c
+      RETURN
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/control.h
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/control.h	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/control.h	(revision 497)
@@ -4,8 +4,9 @@
       COMMON/control/nday,day_step,
      $              iperiod,iconser,iecri,idissip,iphysiq ,
-     $              periodav,ecritphy,iecrimoy,dayref,anneeref
+     $              periodav,ecritphy,iecrimoy,dayref,anneeref,
+     $              raz_date
 
       INTEGER   nday,day_step,iperiod,iconser,iecri,
-     $          idissip,iphysiq,iecrimoy,dayref,anneeref
+     $          idissip,iphysiq,iecrimoy,dayref,anneeref, raz_date
       REAL periodav, ecritphy
 
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_etat0.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/create_etat0.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_etat0.F	(revision 497)
@@ -1,2 +1,5 @@
+c
+c $Header$
+c
       PROGRAM create_etat0
 C
@@ -4,5 +7,14 @@
 C   
 C
-      CALL etat0_netcdf
+      LOGICAL interbar
+      PARAMETER ( interbar = .TRUE. )
+#include "dimensions.h"
+#include "paramet.h"
+#include "indicesol.h"
+#include "dimphy.h"
+      REAL :: masque(iip1,jjp1)
+      REAL :: pctsrf(klon, nbsrf)
+
+      CALL etat0_netcdf( interbar, masque, pctsrf )
       STOP
       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_etat0_limit.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_etat0_limit.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_etat0_limit.F	(revision 497)
@@ -0,0 +1,43 @@
+       PROGRAM create_etat0_limit
+c
+c
+c     Programme d'appel a etat0, creation des etats initiaux et limit_netcdf
+c   
+c
+c     interbar = .T . si appel a  interpol. barycentrique inter_barxy
+c
+c     extrap   = .T . si on fait une extrapolation de donnees , comme pour
+c       les  SST  lorsque  le fichier ne contient pas uniquement  des points 
+c     oceaniques .
+c
+c     oldice   = .T. si l'on veut garder les anciennes glaces , obtenues
+c     par  grille_m  ( grid_atob ) .
+c
+c     on cree le masque dans etat0 que l'on passe ensuite dans limit pour 
+c     garder les cohérences
+
+      LOGICAL interbar, extrap , oldice
+      PARAMETER ( interbar = .true. , extrap = .FALSE. , oldice=.false.)
+#include "dimensions.h"
+#include "paramet.h"
+#include "indicesol.h"
+#include "dimphy.h"
+      REAL :: masque(iip1,jjp1)
+      REAL :: pctsrf(klon, nbsrf)
+
+      WRITE(6,*) '  *********************  '
+      WRITE(6,*) ' interbar = ',interbar
+      CALL etat0_netcdf ( interbar, masque, pctsrf )
+c
+      WRITE(6,1)
+      WRITE(6,*) '  *********************  '
+      WRITE(6,*) '  ***  Limit_netcdf ***  '
+      WRITE(6,*) '  *********************  '
+      WRITE(6,1)
+c
+      CALL  limit_netcdf ( interbar, extrap , oldice, masque, pctsrf )
+
+1     FORMAT(//)
+
+      STOP
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_limit.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/create_limit.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/create_limit.F	(revision 497)
@@ -1,3 +1,6 @@
+c $Header$
       PROGRAM create_limit
+      USE startvar
+      USE ioipsl
       IMPLICIT none
 c
@@ -13,4 +16,5 @@
 c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
 c                         pour lecture netcdf dans LMDZ.3.3
+c modifie par P. Braconnot pour utiliser la version sous-surfaces
 c-------------------------------------------------------------
 c
@@ -23,20 +27,32 @@
 #include "comgeom2.h"
 #include "comconst.h"
-c
+#include "dimphy.h"
+#include "indicesol.h"
 c-----------------------------------------------------------------------
-      INTEGER KIDIA, KFDIA, KLON, KLEV
-      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2,
-     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
-c-----------------------------------------------------------------------
-      REAL phy_nat(klon,360), phy_nat0(klon)
+      REAL phy_nat(klon,360)
+      real phy_nat0(klon)
       REAL phy_alb(klon,360)
       REAL phy_sst(klon,360)
       REAL phy_bil(klon,360)
       REAL phy_rug(klon,360)
-      REAL phy_ice(klon,360)
+      REAL phy_ice(klon)
+      logical interbar
+      parameter (interbar=.false.)
+CPB
+c      REAL phy_icet(klon,360)
+c      REAL phy_oce(klon,360)
+      real pctsrf_t(klon,nbsrf,360)
+      real pctsrf(klon,nbsrf)
+      REAL verif
 c
       REAL masque(iip1,jjp1)
       REAL mask(iim,jjp1)
-
+CPB
+C newlmt indique l'utilisation de la sous-maille fractionnelle
+C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
+      LOGICAL newlmt, fracterre
+      PARAMETER(newlmt=.TRUE.)
+      PARAMETER(fracterre = .TRUE.) 
+CPB
 C Declarations pour le champ de depart
       INTEGER imdep, jmdep,lmdep
@@ -52,5 +68,5 @@
       REAL champ_msk(ibid_msk*jbid_msk)
       REAL dlon_msk(ibid_msk), dlat_msk(jbid_msk)
-
+      REAL*4 zbidon(ibid_msk*jbid_msk) 
 C Declarations pour le champ interpole 2D
       REAL champint(iim,jjp1)
@@ -75,8 +91,27 @@
       INTEGER id_tim
       INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
-
-      INTEGER i, j, k, l
+CPB
+      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
+
+      INTEGER i, j, k, l, ji
+c declarations pour lecture glace de mer
+      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
+      INTEGER :: itaul(1), fid
+      REAL :: lev(1), date, dt
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
+      REAL :: flic_tmp(iip1, jjp1)
 c Diverses variables locales
       REAL time
+! pour la lecture du fichier masque ocean
+      integer :: nid_o2a
+      logical :: couple = .false.
+      INTEGER :: iml_omask, jml_omask
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
+      real, dimension(klon) :: ocemask_fi
+
 
       INTEGER          longcles
@@ -86,9 +121,11 @@
       INTEGER ncid,varid,ndimid(4),dimid
       character*30 namedim
+      CHARACTER*80 :: varname
 
 c initialisations:
-      OPEN (8,file='run.def',form='formatted')
-      CALL defrun_new(8,.TRUE.,clesphy0)
-      CLOSE(8)
+!      OPEN (8,file='run.def',form='formatted')
+!      CALL defrun_new(8,.TRUE.,clesphy0)
+!      CLOSE(8)
+      CALL conf_gcm( 99, .TRUE. , clesphy0 )
 
       pi     = 4. * ATAN(1.)
@@ -100,4 +137,5 @@
       cpp    = 1004.70885
       dtvr    = daysec/FLOAT(day_step)
+
 c
 ccc      CALL iniconst ( non  indispensable )
@@ -108,7 +146,174 @@
 C Traitement du relief au sol
 c
-      write(*,*) 'Traitement du relief au sol pour fabriquer masque'
-      ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
-
+      write(*,*) 'Fabrication masque'
+
+      varname = 'masque'
+      masque(:,:) = 0.0
+      CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm
+     ,     ,rlonu,rlatv , interbar )
+      pctsrf=0.
+      varname = 'zmasq'
+      zmasq(:) = 0.
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0,
+     .jjm ,rlonu,rlatv , interbar)
+      WHERE (zmasq(1 : klon) .LT. EPSFRA)
+          zmasq(1 : klon) = 0.
+      END WHERE 
+      WHERE (1 - zmasq(1 : klon) .LT. EPSFRA)
+          zmasq(1 : klon) = 1.
+      END WHERE 
+!      WRITE(*,*)zmasq
+
+      IF ( fracterre ) THEN
+          DO i = 1, iim
+            masque(i,1) = masque(i,1)
+            masque(i,jjp1) = masque(i,jjp1)
+          END DO
+      ELSE 
+          DO i = 1, iim
+            masque(i,1) = FLOAT(NINT(masque(i,1)))
+            masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
+          END DO
+      ENDIF 
+c$$$      DO i = 1, iim
+c$$$      DO j = 1, jjp1
+c$$$         mask(i,j) = masque(i,j)
+c$$$      ENDDO
+c$$$      ENDDO
+c$$$      CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
+      phy_nat0(1:klon) = zmasq(1:klon)
+      mask = 0.
+      DO j = 1, jjp1
+        DO i = 1, iim
+          IF ( masque(i,j) .GE. EPSFRA) mask (i,j) = 1
+        END DO 
+      END DO  
+C
+C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
+C utilise pour calculer les poids et pour assurer l'adequation entre les
+C fractions d'ocean vu par l'atmosphere et l'ocean
+C
+
+      write(*,*)'Essai de lecture masque ocean'
+      iret = nf_open("o2a.nc", NF_NOWRITE, nid_o2a)
+      if (iret .ne. 0) then
+        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
+        write(*,*)'Run force'
+      else
+        couple = .true.
+        iret = nf_close(nid_o2a)
+        call flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp
+     $    , nid_o2a)
+        if (iml_omask /= iim .or. jml_omask /= jjp1) then
+          write(*,*)'Dimensions non compatibles pour masque ocean'
+          write(*,*)'iim = ',iim,' iml_omask = ',iml_omask
+          write(*,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
+          stop
+        endif
+        ALLOCATE(lat_omask(iml_omask, jml_omask), stat=iret)
+        ALLOCATE(lon_omask(iml_omask, jml_omask), stat=iret)
+        ALLOCATE(dlon_omask(iml_omask), stat=iret)
+        ALLOCATE(dlat_omask(jml_omask), stat=iret)
+        ALLOCATE(ocemask(iml_omask, jml_omask), stat=iret)
+        ALLOCATE(ocetmp(iml_omask, jml_omask), stat=iret)
+        CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp
+     $    , lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
+        CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, 
+     $      ttm_tmp, 1, 1, ocetmp)
+        CALL flinclo(fid)
+        dlon_omask(1 : iml_omask) = lon_omask(1 : iml_omask, 1)
+        dlat_omask(1 : jml_omask) = lat_omask(1 , 1 : jml_omask)
+        ocemask = ocetmp
+        if (dlat_omask(1) < dlat_omask(jml_omask)) then
+          do j = 1, jml_omask
+            ocemask(:,j) = ocetmp(:,jml_omask-j+1)
+          enddo
+        endif 
+C
+C passage masque ocean a la grille physique
+C
+        ocemask_fi(1) = ocemask(1,1)
+        do j = 2, jjm
+          do i = 1, iim
+            ocemask_fi((j-2)*iim + i + 1) = ocemask(i,j)
+          enddo
+        enddo
+        ocemask_fi(klon) = ocemask(1,jjp1)
+        zmasq = 1. - ocemask_fi
+      endif
+
+
+C
+C lecture du fichier glace de terre pour fixer la fraction de terre 
+C et de glace de terre
+C
+      CALL flininfo("landiceref.nc", iml_lic, jml_lic,llm_tmp, ttm_tmp
+     $    , fid)
+      ALLOCATE(lat_lic(iml_lic, jml_lic), stat=iret)
+      ALLOCATE(lon_lic(iml_lic, jml_lic), stat=iret)
+      ALLOCATE(dlon_lic(iml_lic), stat=iret)
+      ALLOCATE(dlat_lic(jml_lic), stat=iret)
+      ALLOCATE(fraclic(iml_lic, jml_lic), stat=iret)
+      CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp
+     $    , lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
+      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp
+     $    , 1, 1, fraclic)
+      CALL flinclo(fid)
+C
+C interpolation sur la grille T du modele
+C
+      WRITE(*,*) 'dimensions de landice iml_lic, jml_lic : ', 
+     $    iml_lic, jml_lic
+c
+C sil les coordonnees sont en degres, on les transforme
+C
+      IF( MAXVAL( lon_lic(:,:) ) .GT. 2.0 * asin(1.0) )  THEN
+          lon_lic(:,:) = lon_lic(:,:) * 2.0* ASIN(1.0) / 180.
+      ENDIF 
+      IF( maxval( lat_lic(:,:) ) .GT. 2.0 * asin(1.0)) THEN 
+          lat_lic(:,:) = lat_lic(:,:) * 2.0 * asin(1.0) / 180.
+      ENDIF 
+
+      dlon_lic(1 : iml_lic) = lon_lic(1 : iml_lic, 1)
+      dlat_lic(1 : jml_lic) = lat_lic(1 , 1 : jml_lic) 
+C
+      CALL grille_m(iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic
+     $    ,iim, jjp1,
+     $    rlonv, rlatu, flic_tmp(1 : iim, 1 : jjp1))
+c$$$      flic_tmp(1 : iim, 1 : jjp1) = champint(1: iim, 1 : jjp1)
+      flic_tmp(iip1, 1 : jjp1) = flic_tmp(1 , 1 : jjp1)
+C
+C passage sur la grille physique
+C
+      CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp,
+     $    pctsrf(1:klon, is_lic))
+C adequation avec le maque terre/mer
+      WHERE (pctsrf(1 : klon, is_lic) .LT. EPSFRA ) 
+          pctsrf(1 : klon, is_lic) = 0. 
+      END WHERE
+      WHERE (zmasq( 1 : klon) .LT. EPSFRA) 
+          pctsrf(1 : klon, is_lic) = 0.
+      END WHERE 
+      pctsrf(1 : klon, is_ter) = zmasq(1 : klon)
+      DO ji = 1, klon
+        IF (zmasq(ji) .GT. EPSFRA) THEN 
+            IF ( pctsrf(ji, is_lic) .GE. zmasq(ji)) THEN
+                pctsrf(ji, is_lic) = zmasq(ji)
+                pctsrf(ji, is_ter) = 0.
+            ELSE 
+                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
+                IF (pctsrf(ji,is_ter) .LT. EPSFRA) THEN
+                    pctsrf(ji,is_ter) = 0.
+                    pctsrf(ji, is_lic) = zmasq(ji)
+                ENDIF 
+            ENDIF 
+        ENDIF 
+      END DO 
+c
+c
+C Traitement de la rugosite
+c
+      PRINT*, 'Traitement de la rugosite'
+      ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -116,5 +321,5 @@
       ENDIF
 
-      ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
+      ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -125,10 +330,10 @@
         print *, NF_STRERROR(ierr)
         STOP
-      ENDIF
+      ENDIF 
       ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
         STOP
-      ENDIF
+      ENDIF 
       print*,'variable ', namedim, 'dimension ', imdep
       ierr = NF_INQ_VARID(ncid,namedim,dimid)
@@ -136,15 +341,19 @@
         print *, NF_STRERROR(ierr)
         STOP
-      ENDIF
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_msk)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
       ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
         STOP
-      ENDIF
+      ENDIF 
       print*,'variable ', namedim, 'dimension ', jmdep
       ierr = NF_INQ_VARID(ncid,namedim,dimid)
@@ -152,80 +361,10 @@
         print *, NF_STRERROR(ierr)
         STOP
-      ENDIF
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_msk)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-
-c
-      CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk,
-     .             iim, jjp1, rlonv, rlatu, champint)
-      CALL gr_int_dyn(champint, masque, iim, jjp1)
-      DO i = 1, iim
-         masque(i,1) = FLOAT(NINT(masque(i,1)))
-         masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
-      ENDDO
-      DO i = 1, iim
-      DO j = 1, jjp1
-         mask(i,j) = champint(i,j)
-      ENDDO
-      ENDDO
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
-      ierr = NF_CLOSE(ncid)
-c
-c
-C Traitement de la rugosite
-c
-      PRINT*, 'Traitement de la rugosite'
-      ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-
-      ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF
-      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', imdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
-      print*,'variable ', namedim, 'dimension ', jmdep
-      ierr = NF_INQ_VARID(ncid,namedim,dimid)
-      if (ierr.ne.0) then
-        print *, NF_STRERROR(ierr)
-        STOP
-      ENDIF 
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -243,5 +382,9 @@
         STOP
       ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -260,5 +403,9 @@
          PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
          print*,dimfirst,dimlast
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
          ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
          if (ierr.ne.0) then
            print *, NF_STRERROR(ierr)
@@ -274,4 +421,5 @@
          ENDDO
       ENDDO
+c      write(70,*)champtime
 c
       DO l = 1, lmdep
@@ -343,5 +491,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -359,5 +511,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -375,5 +531,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -391,5 +551,9 @@
 c
          PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
          ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
          if (ierr.ne.0) then
            print *, NF_STRERROR(ierr)
@@ -432,17 +596,107 @@
       ENDDO
 c
+c      WRITE(*,*) 'phy_nat'
+c     WRITE(*,'(72f4.1)') phy_nat0(1:klon)
+c
       DO k = 1, 360
-         CALL gr_dyn_fi(1, iip1, jjp1, klon,
-     .                  champan(1,1,k), phy_ice(1,k))
-         DO i = 1, klon
+        CALL gr_dyn_fi(1, iip1, jjp1, klon,
+     .      champan(1,1,k), phy_ice)
+        IF ( newlmt) THEN
+
+CPB  en attendant de mettre fraction de terre
+c
+          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
+          WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
+c 
+          IF (fracterre ) THEN
+c            WRITE(*,*) 'passe dans cas fracterre' 
+            pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
+            pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
+            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon) 
+     $            - pctsrf_t(1:klon,is_lic,k)
+c§§ Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
+            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
+                pctsrf_t(1:klon,is_sic,k) = 0.
+            END WHERE 
+            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
+                pctsrf_t(1:klon,is_sic,k) = 0.
+                pctsrf_t(1:klon,is_oce,k) = 0.
+            END WHERE
+            DO i = 1, klon
+c$$              pctsrf_t(i,is_sic,k) = (1. - pctsrf_t(i,is_lic,k) -
+c$$     .                               pctsrf_t(i,is_ter,k)) * phy_ice(i)
+c$$              pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_lic,k) -
+c$$     .                      pctsrf_t(i,is_ter,k) - pctsrf_t(i,is_sic,k)
+              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN 
+                  IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
+                      pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
+                      pctsrf_t(i,is_oce,k) = 0.
+                  ELSE 
+                      pctsrf_t(i,is_oce,k) = 1 - zmasq(i) 
+     $                    - pctsrf_t(i,is_sic,k)
+                      IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
+                          pctsrf_t(i,is_oce,k) = 0.
+                          pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
+                      ENDIF 
+                  ENDIF
+              ENDIF  
+              if (pctsrf_t(i,is_oce,k) .lt. 0.) then
+                  WRITE(*,*) 'pb sous maille au point : i,k '
+     $                , i,k,pctsrf_t(:,is_oce,k)
+              ENDIF
+              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) + 
+     $            pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.) 
+     $            .GT. EPSFRA) THEN 
+                  WRITE(*,*) 'physiq : pb sous surface au point ', i, 
+     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
+              ENDIF 
+            END DO
+        ELSE 
+            DO i = 1, klon
+              pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
+              IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
+                pctsrf_t(i,is_sic,k) = 0.
+                pctsrf_t(i,is_oce,k) = 0.                  
+                IF(phy_ice(i) .GE. 1.e-5) THEN
+                  pctsrf_t(i,is_lic,k) = phy_ice(i)
+                  pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k) 
+     .                                   - pctsrf_t(i,is_lic,k)
+                ELSE
+                  pctsrf_t(i,is_lic,k) = 0.
+                ENDIF 
+              ELSE
+                pctsrf_t(i,is_lic,k) = 0. 
+                IF(phy_ice(i) .GE. 1.e-5) THEN 
+                  pctsrf_t(i,is_ter,k) = 0.
+                  pctsrf_t(i,is_sic,k) = phy_ice(i)
+                  pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
+                ELSE
+                  pctsrf_t(i,is_sic,k) = 0.
+                  pctsrf_t(i,is_oce,k) = 1.                      
+                ENDIF 
+              ENDIF
+              verif = pctsrf_t(i,is_ter,k) +
+     .                pctsrf_t(i,is_oce,k) + 
+     .                pctsrf_t(i,is_sic,k) +
+     .                pctsrf_t(i,is_lic,k)
+              IF ( verif .LT. 1. - 1.e-5 .OR. 
+     $             verif .GT. 1 + 1.e-5) THEN  
+                WRITE(*,*) 'pb sous maille au point : i,k,verif '
+     $                    , i,k,verif
+              ENDIF 
+            END DO
+          ENDIF 
+        ELSE  
+          DO i = 1, klon
             phy_nat(i,k) = phy_nat0(i)
-            IF ( (phy_ice(i,k) - 0.5).GE.1.e-5 ) THEN
-               IF (NINT(phy_nat0(i)).EQ.0) THEN
-                  phy_nat(i,k) = 3.0
-               ELSE
-                  phy_nat(i,k) = 2.0
-               ENDIF
+            IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
+              IF (NINT(phy_nat0(i)).EQ.0) THEN
+                phy_nat(i,k) = 3.0
+              ELSE
+                phy_nat(i,k) = 2.0
+              ENDIF
             ENDIF
-         ENDDO
+          END DO
+        ENDIF 
       ENDDO
 c
@@ -480,5 +734,10 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
+#endif
+
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -496,5 +755,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -512,5 +775,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -528,5 +795,9 @@
 c
          PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
          ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
          if (ierr.ne.0) then
            print *, NF_STRERROR(ierr)
@@ -574,4 +845,5 @@
       ENDDO
 c
+      WHERE(phy_sst .LT. 271.35) phy_sst = 271.35
       ierr = NF_CLOSE(ncid)
 c
@@ -606,5 +878,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlon)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -622,5 +898,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,dlat)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -638,5 +918,9 @@
         STOP
       ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
       ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
       if (ierr.ne.0) then
         print *, NF_STRERROR(ierr)
@@ -654,5 +938,9 @@
 c
          PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
          ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
          if (ierr.ne.0) then
            print *, NF_STRERROR(ierr)
@@ -721,25 +1009,40 @@
       dims(2) = ntim
 c
-ccc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
       ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
       ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
      .                        "Jour dans l annee")
-ccc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
-      ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
-      ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
+      IF (newlmt) THEN
+c
+          ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
+          ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
+     .                        "Fraction ocean")
+c
+          ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
+          ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
+     .                        "Fraction glace de mer")
+c
+          ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
+          ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
+     .                        "Fraction terre")
+c
+          ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
+          ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
+     .                        "Fraction land ice")
+c
+      ELSE 
+          ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
+          ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
      .                        "Nature du sol (0,1,2,3)")
-ccc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
+      ENDIF 
+C 
       ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
       ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
      .                        "Temperature superficielle de la mer")
-ccc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
       ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
       ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
      .                        "Reference flux de chaleur au sol")
-ccc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
       ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
       ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
      .                        "Albedo a la surface")
-ccc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
       ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
       ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
@@ -757,5 +1060,19 @@
 #ifdef NC_DOUBLE
       ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
-      ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
+c
+      IF (newlmt ) THEN
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
+     $        ,pctsrf_t(1,is_oce,k))
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
+     $        ,pctsrf_t(1,is_sic,k))
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
+     $        ,pctsrf_t(1,is_ter,k))
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
+     $        ,pctsrf_t(1,is_lic,k))
+      ELSE 
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
+     $        ,phy_nat(1,k))
+      ENDIF 
+c
       ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
       ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
@@ -764,5 +1081,17 @@
 #else
       ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
-      ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
+      IF (newlmt ) THEN
+          ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
+     $        ,pctsrf_t(1,is_oce,k))
+          ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
+     $        ,pctsrf_t(1,is_sic,k))
+          ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
+     $        ,pctsrf_t(1,is_ter,k))
+          ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
+     $        ,pctsrf_t(1,is_lic,k))
+      ELSE 
+          ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
+     $        ,phy_nat(1,k))
+      ENDIF 
       ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
       ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
@@ -777,2 +1106,3 @@
       STOP
       END
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/defrun_new.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/defrun_new.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/defrun_new.F	(revision 497)
@@ -1,2 +1,5 @@
+c
+c $Header$
+c
       SUBROUTINE defrun_new( tapedef, etatinit, clesphy0 )
 c
@@ -36,5 +39,5 @@
       INTEGER   tapeout
       REAL clonn,clatt,grossismxx,grossismyy
-      REAL dzoomxx,dzoomyy
+      REAL dzoomxx,dzoomyy,tauxx,tauyy
       LOGICAL  fxyhypbb, ysinuss
       INTEGER i
@@ -75,5 +78,5 @@
 c-----------------------------------------------------------------------
 
-      OPEN( tapedef,file ='run.def',status='old',form='formatted')
+      OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
 
 
@@ -258,9 +261,8 @@
       WRITE(tapeout,*)    clonn
       IF( ABS(clon - clonn).GE. 0.001 )  THEN
-        PRINT *,' La valeur de clon passee par run.def est differente de 
-     *  celle lue sur le fichier  start '
+       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
+     *rente de  celle lue sur le fichier  start '
         STOP
       ENDIF
-c
 c
       READ (tapedef,9001) ch1,ch4
@@ -270,6 +272,6 @@
 
       IF( ABS(clat - clatt).GE. 0.001 )  THEN
-        PRINT *,' La valeur de clat passee par run.def est differente de 
-     *  celle lue sur le fichier  start '
+       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
+     *rente de  celle lue sur le fichier  start '
         STOP
       ENDIF
@@ -281,6 +283,6 @@
 
       IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
-        PRINT *,' La valeur de grossismx passee par run.def est differente  
-     *  de celle lue sur le fichier  start '
+       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
+     , differente de celle lue sur le fichier  start '
         STOP
       ENDIF
@@ -292,11 +294,11 @@
 
       IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
-        PRINT *,' La valeur de grossismy passee par run.def est differen
-     * te de celle lue sur le fichier  start '
+       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
+     , differente de celle lue sur le fichier  start '
         STOP
       ENDIF
       
       IF( grossismx.LT.1. )  THEN
-        PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
          STOP
       ELSE
@@ -306,5 +308,5 @@
 
       IF( grossismy.LT.1. )  THEN
-        PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
          STOP
       ELSE
@@ -312,5 +314,4 @@
       ENDIF
 
-      PRINT *,' alphax alphay defrun ',alphax,alphay
 c
 c    alphax et alphay sont les anciennes formulat. des grossissements
@@ -324,14 +325,14 @@
       IF( .NOT.fxyhypb )  THEN
            IF( fxyhypbb )     THEN
-              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
-              PRINT *,' *** fxyhypb lu sur le fichier start est F ',
-     *       'alors  qu il est  T  sur  run.def  ***'
+            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
+            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
+     *,      '                   alors  qu il est  T  sur  run.def  ***'
               STOP
            ENDIF
       ELSE
            IF( .NOT.fxyhypbb )   THEN
-              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
-              PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
-     *        'alors  qu il est  F  sur  run.def  ****  '
+            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
+            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
+     *,      '                   alors  qu il est  F  sur  run.def  ***'
               STOP
            ENDIF
@@ -343,12 +344,4 @@
       WRITE(tapeout,*)    dzoomxx
 
-      IF( fxyhypb )  THEN
-       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
-        PRINT *,' La valeur de dzoomx passee par run.def est differente 
-     *  de celle lue sur le fichier  start '
-        STOP
-       ENDIF
-      ENDIF
-
       READ (tapedef,9001) ch1,ch4
       READ (tapedef,*)    dzoomyy
@@ -356,10 +349,40 @@
       WRITE(tapeout,*)    dzoomyy
 
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tauxx
+      WRITE(tapeout,9001) ch1,'taux'
+      WRITE(tapeout,*)    tauxx
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tauyy
+      WRITE(tapeout,9001) ch1,'tauy'
+      WRITE(tapeout,*)    tauyy
+
       IF( fxyhypb )  THEN
+
+       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
+        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
+     *ferente de celle lue sur le fichier  start '
+        CALL ABORT
+       ENDIF
+
        IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
-        PRINT *,' La valeur de dzoomy passee par run.def est differente 
-     * de celle lue sur le fichier  start '
-        STOP
+        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
+     *ferente de celle lue sur le fichier  start '
+        CALL ABORT
        ENDIF
+
+       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
+        WRITE(6,*)' La valeur de taux passee par run.def est differente
+     *  de celle lue sur le fichier  start '
+        CALL ABORT
+       ENDIF
+
+       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
+        WRITE(6,*)' La valeur de tauy passee par run.def est differente
+     *  de celle lue sur le fichier  start '
+        CALL ABORT
+       ENDIF
+
       ENDIF
       
@@ -374,14 +397,14 @@
         IF( .NOT.ysinus )  THEN
            IF( ysinuss )     THEN
-              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
-              PRINT *,' *** ysinus lu sur le fichier start est F ',
-     *       'alors  qu il est  T  sur  run.def  ***'
+              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
+              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
+     *       ' alors  qu il est  T  sur  run.def  ***'
               STOP
            ENDIF
         ELSE
            IF( .NOT.ysinuss )   THEN
-              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
-              PRINT *,' ***  ysinus lu sur le fichier start est T ',
-     *        'alors  qu il est  F  sur  run.def  ****  '
+              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
+              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
+     *       ' alors  qu il est  F  sur  run.def  ***'
               STOP
            ENDIF
@@ -389,5 +412,8 @@
       ENDIF
 c
-      close(tapedef)
+      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
+
+      CLOSE(tapedef)
+
       RETURN
 c   ...............................................
@@ -416,5 +442,5 @@
 
       IF( grossismx.LT.1. )  THEN
-        PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
+        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
          STOP
       ELSE
@@ -423,5 +449,5 @@
 
       IF( grossismy.LT.1. )  THEN
-        PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
+        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
          STOP
       ELSE
@@ -429,6 +455,4 @@
       ENDIF
 
-      PRINT *,' alphax alphay defrun ',alphax,alphay
-
 c
       READ (tapedef,9001) ch1,ch4
@@ -446,5 +470,15 @@
       WRITE(tapeout,9001) ch1,'dzoomy'
       WRITE(tapeout,*)    dzoomy
-c
+
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    taux
+      WRITE(tapeout,9001) ch1,'taux'
+      WRITE(tapeout,*)    taux
+c
+      READ (tapedef,9001) ch1,ch4
+      READ (tapedef,*)    tauy
+      WRITE(tapeout,9001) ch1,'tauy'
+      WRITE(tapeout,*)    tauy
+
       READ (tapedef,9001) ch1,ch4
       READ (tapedef,*)    ysinus
@@ -452,9 +486,11 @@
       WRITE(tapeout,*)    ysinus
        
+      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
 c
 9000  FORMAT(3(/,a72))
 9001  FORMAT(/,a72,/,a12)
 cc
-      close(tapedef)
+      CLOSE(tapedef)
+
       RETURN
       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/diagedyn.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/diagedyn.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/diagedyn.F	(revision 497)
@@ -0,0 +1,308 @@
+
+C======================================================================
+      SUBROUTINE diagedyn(tit,iprt,idiag,idiag2,dtime
+     e  , ucov    , vcov , ps, p ,pk , teta , q, ql,aire
+     s  , d_h_vcol , d_qt, d_qw, d_ql, d_ec)
+C======================================================================
+C
+C Purpose:
+C    Calcul la difference d'enthalpie et de masse d'eau entre 2 appels,
+C    et calcul le flux de chaleur et le flux d'eau necessaire a ces 
+C    changements. Ces valeurs sont moyennees sur la surface de tout
+C    le globe et sont exprime en W/2 et kg/s/m2
+C    Outil pour diagnostiquer la conservation de l'energie
+C    et de la masse dans la dynamique.
+C
+C
+c======================================================================
+C Arguments: 
+C tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
+C iprt----input-I-  PRINT level ( <=1 : no PRINT)
+C idiag---input-I- indice dans lequel sera range les nouveaux
+C                  bilans d' entalpie et de masse
+C idiag2--input-I-les nouveaux bilans d'entalpie et de masse 
+C                 sont compare au bilan de d'enthalpie de masse de
+C                 l'indice numero idiag2 
+C                 Cas parriculier : si idiag2=0, pas de comparaison, on
+c                 sort directement les bilans d'enthalpie et de masse 
+C dtime----input-R- time step (s)
+C uconv, vconv-input-R- vents covariants (m/s)
+C ps-------input-R- Surface pressure (Pa)
+C p--------input-R- pressure at the interfaces
+C pk-------input-R- pk= (p/Pref)**kappa
+c teta-----input-R- potential temperature (K)
+c q--------input-R- vapeur d'eau (kg/kg)
+c ql-------input-R- liquid watter (kg/kg)
+c aire-----input-R- mesh surafce (m2)
+c
+C the following total value are computed by UNIT of earth surface
+C
+C d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy 
+c            change (J/m2) during one time step (dtime) for the whole 
+C            atmosphere (air, watter vapour, liquid and solid)
+C d_qt------output-R- total water mass flux (kg/m2/s) defined as the 
+C           total watter (kg/m2) change during one time step (dtime),
+C d_qw------output-R- same, for the watter vapour only (kg/m2/s)
+C d_ql------output-R- same, for the liquid watter only (kg/m2/s)
+C d_ec------output-R- Cinetic Energy Budget (W/m2) for vertical air column
+C
+C
+C J.L. Dufresne, July 2002
+c======================================================================
+ 
+      IMPLICIT NONE
+C
+#include "dimensions.h"
+#include "paramet.h"
+#include "../phylmd/YOMCST.h"
+#include "../phylmd/YOETHF.h"
+C
+      INTEGER imjmp1
+      PARAMETER( imjmp1=iim*jjp1)
+c     Input variables
+      CHARACTER*15 tit
+      INTEGER iprt,idiag, idiag2
+      REAL dtime
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL ps(ip1jmp1)                       ! pression  au sol
+      REAL p (ip1jmp1,llmp1  )  ! pression aux interfac.des couches
+      REAL pk (ip1jmp1,llm  )  ! = (p/Pref)**kappa
+      REAL teta(ip1jmp1,llm)                 ! temperature potentielle 
+      REAL q(ip1jmp1,llm)               ! champs eau vapeur
+      REAL ql(ip1jmp1,llm)               ! champs eau liquide
+      REAL aire(ip1jmp1)               ! aire des mailles
+
+
+c     Output variables
+      REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
+C
+C     Local variables
+c
+      REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot
+     .  , h_qs_tot, qw_tot, ql_tot, qs_tot , ec_tot
+c h_vcol_tot--  total enthalpy of vertical air column 
+C            (air with watter vapour, liquid and solid) (J/m2)
+c h_dair_tot-- total enthalpy of dry air (J/m2)
+c h_qw_tot----  total enthalpy of watter vapour (J/m2)
+c h_ql_tot----  total enthalpy of liquid watter (J/m2)
+c h_qs_tot----  total enthalpy of solid watter  (J/m2)
+c qw_tot------  total mass of watter vapour (kg/m2)
+c ql_tot------  total mass of liquid watter (kg/m2)
+c qs_tot------  total mass of solid watter (kg/m2)
+c ec_tot------  total cinetic energy (kg/m2)
+C
+      REAL masse(ip1jmp1,llm)                ! masse d'air
+      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL ecin(ip1jmp1,llm)
+
+      REAL zaire(imjmp1)
+      REAL zps(imjmp1)
+      REAL zairm(imjmp1,llm)
+      REAL zecin(imjmp1,llm)
+      REAL zpaprs(imjmp1,llm)
+      REAL zpk(imjmp1,llm)
+      REAL zt(imjmp1,llm)
+      REAL zh(imjmp1,llm)
+      REAL zqw(imjmp1,llm)
+      REAL zql(imjmp1,llm)
+      REAL zqs(imjmp1,llm)
+
+      REAL  zqw_col(imjmp1)
+      REAL  zql_col(imjmp1)
+      REAL  zqs_col(imjmp1)
+      REAL  zec_col(imjmp1)
+      REAL  zh_dair_col(imjmp1)
+      REAL  zh_qw_col(imjmp1), zh_ql_col(imjmp1), zh_qs_col(imjmp1)
+C
+      REAL      d_h_dair, d_h_qw, d_h_ql, d_h_qs
+C
+      REAL airetot, zcpvap, zcwat, zcice
+C
+      INTEGER i, k, jj, ij , l ,ip1jjm1
+C
+      INTEGER ndiag     ! max number of diagnostic in parallel
+      PARAMETER (ndiag=10)
+      integer pas(ndiag)
+      save pas
+      data pas/ndiag*0/
+C     
+      REAL      h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag)
+     $    , h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag)
+     $    , ql_pre(ndiag), qs_pre(ndiag) , ec_pre(ndiag)
+      SAVE      h_vcol_pre, h_dair_pre, h_qw_pre, h_ql_pre
+     $        , h_qs_pre, qw_pre, ql_pre, qs_pre , ec_pre
+
+
+c======================================================================
+C     Compute Kinetic enrgy
+      CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
+      CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
+      CALL massdair( p, masse )
+c======================================================================
+C
+C
+C     On ne garde les donnees que dans les colonnes i=1,iim
+      DO jj = 1,jjp1
+        ip1jjm1=iip1*(jj-1)
+        DO ij =  1,iim
+          i=iim*(jj-1)+ij
+          zaire(i)=aire(ij+ip1jjm1)
+          zps(i)=ps(ij+ip1jjm1)
+        ENDDO 
+      ENDDO 
+C 3D arrays
+      DO l  =  1, llm
+        DO jj = 1,jjp1
+          ip1jjm1=iip1*(jj-1)
+          DO ij =  1,iim
+            i=iim*(jj-1)+ij
+            zairm(i,l) = masse(ij+ip1jjm1,l)
+            zecin(i,l) = ecin(ij+ip1jjm1,l)
+            zpaprs(i,l) = p(ij+ip1jjm1,l)
+            zpk(i,l) = pk(ij+ip1jjm1,l)
+            zh(i,l) = teta(ij+ip1jjm1,l)
+            zqw(i,l) = q(ij+ip1jjm1,l)
+            zql(i,l) = ql(ij+ip1jjm1,l)
+            zqs(i,l) = 0.
+          ENDDO 
+        ENDDO 
+      ENDDO 
+C
+C     Reset variables
+      DO i = 1, imjmp1
+        zqw_col(i)=0.
+        zql_col(i)=0.
+        zqs_col(i)=0.
+        zec_col(i) = 0.
+        zh_dair_col(i) = 0.
+        zh_qw_col(i) = 0.
+        zh_ql_col(i) = 0.
+        zh_qs_col(i) = 0.
+      ENDDO
+C
+      zcpvap=RCPV
+      zcwat=RCW
+      zcice=RCS
+C
+C     Compute vertical sum for each atmospheric column
+C     ================================================
+      DO k = 1, llm
+        DO i = 1, imjmp1
+C         Watter mass
+          zqw_col(i) = zqw_col(i) + zqw(i,k)*zairm(i,k)
+          zql_col(i) = zql_col(i) + zql(i,k)*zairm(i,k)
+          zqs_col(i) = zqs_col(i) + zqs(i,k)*zairm(i,k)
+C         Cinetic Energy
+          zec_col(i) =  zec_col(i)
+     $        +zecin(i,k)*zairm(i,k)
+C         Air enthalpy
+          zt(i,k)= zh(i,k) * zpk(i,k) / RCPD
+          zh_dair_col(i) = zh_dair_col(i)
+     $        + RCPD*(1.-zqw(i,k)-zql(i,k)-zqs(i,k))*zairm(i,k)*zt(i,k)
+          zh_qw_col(i) = zh_qw_col(i)
+     $        + zcpvap*zqw(i,k)*zairm(i,k)*zt(i,k) 
+          zh_ql_col(i) = zh_ql_col(i)
+     $        + zcwat*zql(i,k)*zairm(i,k)*zt(i,k) 
+     $        - RLVTT*zql(i,k)*zairm(i,k)
+          zh_qs_col(i) = zh_qs_col(i)
+     $        + zcice*zqs(i,k)*zairm(i,k)*zt(i,k) 
+     $        - RLSTT*zqs(i,k)*zairm(i,k)
+
+        END DO
+      ENDDO
+C
+C     Mean over the planete surface
+C     =============================
+      qw_tot = 0.
+      ql_tot = 0.
+      qs_tot = 0.
+      ec_tot = 0.
+      h_vcol_tot = 0.
+      h_dair_tot = 0.
+      h_qw_tot = 0.
+      h_ql_tot = 0.
+      h_qs_tot = 0.
+      airetot=0.
+C
+      do i=1,imjmp1
+        qw_tot = qw_tot + zqw_col(i)
+        ql_tot = ql_tot + zql_col(i)
+        qs_tot = qs_tot + zqs_col(i)
+        ec_tot = ec_tot + zec_col(i)
+        h_dair_tot = h_dair_tot + zh_dair_col(i)
+        h_qw_tot = h_qw_tot + zh_qw_col(i)
+        h_ql_tot = h_ql_tot + zh_ql_col(i)
+        h_qs_tot = h_qs_tot + zh_qs_col(i)
+        airetot=airetot+zaire(i)
+      END DO
+C
+      qw_tot = qw_tot/airetot
+      ql_tot = ql_tot/airetot
+      qs_tot = qs_tot/airetot
+      ec_tot = ec_tot/airetot
+      h_dair_tot = h_dair_tot/airetot
+      h_qw_tot = h_qw_tot/airetot
+      h_ql_tot = h_ql_tot/airetot
+      h_qs_tot = h_qs_tot/airetot
+C
+      h_vcol_tot = h_dair_tot+h_qw_tot+h_ql_tot+h_qs_tot
+C
+C     Compute the change of the atmospheric state compare to the one 
+C     stored in "idiag2", and convert it in flux. THis computation
+C     is performed IF idiag2 /= 0 and IF it is not the first CALL
+c     for "idiag"
+C     ===================================
+C
+      IF ( (idiag2.gt.0) .and. (pas(idiag2) .ne. 0) ) THEN
+        d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
+        d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
+        d_h_qw   = (h_qw_tot  - h_qw_pre(idiag2)  )/dtime
+        d_h_ql   = (h_ql_tot  - h_ql_pre(idiag2)  )/dtime 
+        d_h_qs   = (h_qs_tot  - h_qs_pre(idiag2)  )/dtime 
+        d_qw     = (qw_tot    - qw_pre(idiag2)    )/dtime
+        d_ql     = (ql_tot    - ql_pre(idiag2)    )/dtime
+        d_qs     = (qs_tot    - qs_pre(idiag2)    )/dtime
+        d_ec     = (ec_tot    - ec_pre(idiag2)    )/dtime
+        d_qt = d_qw + d_ql + d_qs
+      ELSE 
+        d_h_vcol = 0.
+        d_h_dair = 0.
+        d_h_qw   = 0.
+        d_h_ql   = 0.
+        d_h_qs   = 0. 
+        d_qw     = 0.
+        d_ql     = 0.
+        d_qs     = 0.
+        d_ec     = 0.
+        d_qt     = 0.
+      ENDIF 
+C
+      IF (iprt.ge.2) THEN
+        WRITE(6,9000) tit,pas(idiag),d_qt,d_qw,d_ql,d_qs
+ 9000   format('Dyn3d. Watter Mass Budget (kg/m2/s)',A15
+     $      ,1i6,10(1pE14.6))
+        WRITE(6,9001) tit,pas(idiag), d_h_vcol
+ 9001   format('Dyn3d. Enthalpy Budget (W/m2) ',A15,1i6,10(F8.2))
+        WRITE(6,9002) tit,pas(idiag), d_ec
+ 9002   format('Dyn3d. Cinetic Energy Budget (W/m2) ',A15,1i6,10(F8.2))
+C        WRITE(6,9003) tit,pas(idiag), ec_tot
+ 9003   format('Dyn3d. Cinetic Energy (W/m2) ',A15,1i6,10(E15.6))
+        WRITE(6,9004) tit,pas(idiag), d_h_vcol+d_ec
+ 9004   format('Dyn3d. Total Energy Budget (W/m2) ',A15,1i6,10(F8.2))
+      END IF 
+C
+C     Store the new atmospheric state in "idiag"
+C
+      pas(idiag)=pas(idiag)+1
+      h_vcol_pre(idiag)  = h_vcol_tot
+      h_dair_pre(idiag) = h_dair_tot
+      h_qw_pre(idiag)   = h_qw_tot
+      h_ql_pre(idiag)   = h_ql_tot
+      h_qs_pre(idiag)   = h_qs_tot
+      qw_pre(idiag)     = qw_tot
+      ql_pre(idiag)     = ql_tot
+      qs_pre(idiag)     = qs_tot
+      ec_pre (idiag)    = ec_tot
+C
+      RETURN 
+      END 
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/dynetat0.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/dynetat0.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/dynetat0.F	(revision 497)
@@ -1,2 +1,5 @@
+c
+c $Header$
+c
       SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
      .                    teta,q,masse,ps,phis,time)
@@ -79,6 +82,6 @@
       jm         = tab_cntrl(2)
       lllm       = tab_cntrl(3)
-      day_ini    = tab_cntrl(4)
-      anne_ini   = tab_cntrl(5)
+      day_ref    = tab_cntrl(4)
+      annee_ref  = tab_cntrl(5)
       rad        = tab_cntrl(6)
       omeg       = tab_cntrl(7)
@@ -105,4 +108,6 @@
         dzoomx   = tab_cntrl(25)
         dzoomy   = tab_cntrl(26)
+        taux     = tab_cntrl(28)
+        tauy     = tab_cntrl(29)
       ELSE
         fxyhypb = . FALSE .
@@ -110,4 +115,7 @@
         IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE. 
       ENDIF
+
+      day_ini = tab_cntrl(30)
+      itau_dyn = tab_cntrl(31)
 c   .................................................................
 c
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/dynredem.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/dynredem.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/dynredem.F	(revision 497)
@@ -1,3 +1,6 @@
-      SUBROUTINE dynredem0(fichnom,idayref,anneeref,phis,nq)
+c $Header$
+c
+      SUBROUTINE dynredem0(fichnom,iday_end,phis,nq)
+      USE IOIPSL
       IMPLICIT NONE
 c=======================================================================
@@ -20,5 +23,5 @@
 c   Arguments:
 c   ----------
-      INTEGER*4 idayref,anneeref
+      INTEGER iday_end
       REAL phis(ip1jmp1)
       CHARACTER*(*) fichnom
@@ -44,6 +47,16 @@
       INTEGER idim_tim
       INTEGER nid,nvarid
+
+      REAL zan0,zjulian,hours
+      INTEGER yyears0,jjour0, mmois0
+      character*30 unites
+
+
 c-----------------------------------------------------------------------
       modname='dynredem'
+
+      call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
+      call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
+        
 
       DO l=1,length
@@ -53,6 +66,6 @@
        tab_cntrl(2)  = FLOAT(jjm)
        tab_cntrl(3)  = FLOAT(llm)
-       tab_cntrl(4)  = FLOAT(idayref)
-       tab_cntrl(5)  = FLOAT(anneeref)
+       tab_cntrl(4)  = FLOAT(day_ref)
+       tab_cntrl(5)  = FLOAT(annee_ref)
        tab_cntrl(6)  = rad
        tab_cntrl(7)  = omeg
@@ -81,4 +94,7 @@
        tab_cntrl(25) = dzoomx
        tab_cntrl(26) = dzoomy
+       tab_cntrl(27) = 0.
+       tab_cntrl(28) = taux
+       tab_cntrl(29) = tauy
       ELSE
        tab_cntrl(24) = 0.
@@ -86,6 +102,11 @@
        tab_cntrl(26) = dzoomy
        tab_cntrl(27) = 0.
-       IF( ysinus )  tab_cntrl(27) = 1. 
-      ENDIF
+       tab_cntrl(28) = 0.
+       tab_cntrl(29) = 0.
+       IF( ysinus )  tab_cntrl(27) = 1.
+      ENDIF
+
+       tab_cntrl(30) = FLOAT(iday_end)
+       tab_cntrl(31) = FLOAT(itau_dyn + itaufin)
 c
 c    .........................................................
@@ -121,9 +142,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
      .                       "Parametres de controle")
@@ -136,9 +153,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
      .                       "Longitudes des points U")
@@ -151,9 +164,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
      .                       "Latitudes des points U")
@@ -166,9 +175,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
      .                       "Longitudes des points V")
@@ -181,9 +186,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
      .                       "Latitudes des points V")
@@ -196,9 +197,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
      .                       "Numero naturel des couches s")
@@ -211,9 +208,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
      .                       "Numero naturel des couches sigma")
@@ -226,9 +219,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
      .                       "Coefficient A pour hybride")
@@ -241,9 +230,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
      .                       "Coefficient B pour hybride")
@@ -256,9 +241,5 @@
 c
       ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
-#endif
       ierr = NF_ENDDEF(nid)
 #ifdef NC_DOUBLE
@@ -273,9 +254,5 @@
       dims2(1) = idim_rlonu
       dims2(2) = idim_rlatu
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
      .                       "Coefficient de passage pour U")
@@ -290,9 +267,5 @@
       dims2(1) = idim_rlonv
       dims2(2) = idim_rlatv
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
      .                       "Coefficient de passage pour V")
@@ -309,9 +282,5 @@
       dims2(1) = idim_rlonv
       dims2(2) = idim_rlatu
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
      .                       "Aires de chaque maille")
@@ -328,9 +297,5 @@
       dims2(1) = idim_rlonv
       dims2(2) = idim_rlatu
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
      .                       "Geopotentiel au sol")
@@ -346,11 +311,12 @@
       ierr = NF_REDEF (nid) ! entrer dans le mode de definition
 c
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
      .                       "Temps de simulation")
+      write(unites,200)yyears0,mmois0,jjour0
+200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
+     .                         unites)
+
 c
       dims4(1) = idim_rlonu
@@ -358,9 +324,5 @@
       dims4(3) = idim_s
       dims4(4) = idim_tim
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
      .                       "Vitesse U")
@@ -370,9 +332,5 @@
       dims4(3) = idim_s
       dims4(4) = idim_tim
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
      .                       "Vitesse V")
@@ -382,9 +340,5 @@
       dims4(3) = idim_s
       dims4(4) = idim_tim
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
      .                       "Temperature")
@@ -402,9 +356,5 @@
          str3(1:1)='q'
          WRITE(str3(2:3),'(i2.2)') iq
-#ifdef NC_DOUBLE
-         ierr = NF_DEF_VAR (nid,str3,NF_DOUBLE,4,dims4,nvarid)
-#else
          ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
      .                       "Traceurs "//str3)
@@ -417,9 +367,5 @@
       dims4(3) = idim_s
       dims4(4) = idim_tim
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
      .                       "C est quoi ?")
@@ -428,9 +374,5 @@
       dims3(2) = idim_rlatu
       dims3(3) = idim_tim
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
-#else
       ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
-#endif
       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
      .                       "Pression au sol")
@@ -439,5 +381,5 @@
       ierr = NF_CLOSE(nid) ! fermer le fichier
 
-      PRINT*,'iim,jjm,llm,idayref',iim,jjm,llm,idayref
+      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
       PRINT*,'rad,omeg,g,cpp,kappa',
      ,        rad,omeg,g,cpp,kappa
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/etat0_netcdf.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/etat0_netcdf.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/etat0_netcdf.F	(revision 497)
@@ -1,37 +1,67 @@
-      SUBROUTINE etat0_netcdf
+c
+c $Header$
+c
+      SUBROUTINE etat0_netcdf (interbar, masque, pctsrf)
     
       USE startvar
-      USE IOIPSL
+      USE ioipsl
       !
       IMPLICIT NONE
       !
+#include "netcdf.inc"
 #include "dimensions.h"
 #include "paramet.h"
       !
       !
-      INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2, 
-     .KLON=KFDIA-KIDIA+1,KLEV=llm
+!      INTEGER, PARAMETER :: KIDIA=1, KFDIA=iim*(jjm-1)+2, 
+!     .KLON=KFDIA-KIDIA+1,KLEV=llm
       !
 #include "comgeom2.h"
 #include "comvert.h"
 #include "comconst.h"
-      !
+#include "indicesol.h"
+#include "dimphy.h"
+#include "dimsoil.h"
+#include "temps.h"
+      !
+      LOGICAL interbar
       REAL :: latfi(klon), lonfi(klon)
       REAL :: orog(iip1,jjp1), rugo(iip1,jjp1), masque(iip1,jjp1),
      . psol(iip1, jjp1), phis(iip1, jjp1)
-      REAL :: p3d(iip1, jjp1, llmp1)
-      REAL :: uvent(iip1, jjp1, llmp1)
-      REAL :: vvent(iip1, jjm, llmp1)
-      REAL :: t3d(iip1, jjp1, llmp1), tpot(iip1, jjp1, llmp1)
-      REAL :: q3d(iip1, jjp1, llmp1,nqmx), qsat(iip1, jjp1, llmp1)
-      REAL :: tsol(klon), qsol(klon), sn(klon), radsol(klon)
-      REAL :: deltat(klon), rugmer(klon), agesno(klon), zmea(klon)
-      REAL :: zstd(klon), zsig(klon), zgam(klon), zthe(klon)
-      REAL :: zpic(klon), zval(klon), rugsrel(klon)
-      REAL :: qd(iip1, jjp1, llmp1)
-      !
+      REAL :: p3d(iip1, jjp1, llm+1)
+      REAL :: uvent(iip1, jjp1, llm)
+      REAL :: vvent(iip1, jjm, llm)
+      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
+      REAL :: q3d(iip1, jjp1, llm,nqmx), qsat(iip1, jjp1, llm)
+      REAL :: tsol(klon), qsol(klon), sn(klon)
+      REAL :: tsolsrf(klon,nbsrf), qsurf(klon,nbsrf),snsrf(klon,nbsrf) 
+      REAL :: albe(klon,nbsrf), evap(klon,nbsrf), alblw(klon,nbsrf)
+      REAL :: tsoil(klon,nsoilmx,nbsrf) 
+      REAL :: radsol(klon),rain_fall(klon), snow_fall(klon)
+      REAL :: solsw(klon), sollw(klon), fder(klon)
+      REAL :: deltat(klon), frugs(klon,nbsrf), agesno(klon,nbsrf)
+      REAL :: rugmer(klon)
+      REAL :: zmea(iip1*jjp1), zstd(iip1*jjp1)
+      REAL :: zsig(iip1*jjp1), zgam(iip1*jjp1), zthe(iip1*jjp1)
+      REAL :: zpic(iip1*jjp1), zval(iip1*jjp1), rugsrel(iip1*jjp1)
+      REAL :: qd(iip1, jjp1, llm)
+      REAL :: pctsrf(klon, nbsrf)
+      REAL :: t_ancien(klon,klev), q_ancien(klon,klev)      !
+      real :: clwcon(klon,klev),rnebcon(klon,klev),ratqs(klon,klev)
+      ! declarations pour lecture glace de mer
+      REAL :: rugv(klon)
+      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
+      INTEGER :: itaul(1), fid
+      REAL :: lev(1), date
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
+      REAL :: flic_tmp(iip1, jjp1)
+      REAL :: champint(iim, jjp1)
+      !
+
       CHARACTER*80 :: varname
       !
-      INTEGER :: i,j, ig, l
+      INTEGER :: i,j, ig, l, ji,ii1,ii2, n
       REAL :: xpi
       !
@@ -49,10 +79,10 @@
 #include "control.h"
 #include "serre.h"
-#include "clesph0.h"
+#include "clesphys.h"
 
       INTEGER  ::        longcles
       PARAMETER      ( longcles  = 20 )
       REAL :: clesphy0 ( longcles       )
-      REAL :: p(iip1,jjp1,llmp1)
+      REAL :: p(iip1,jjp1,llm)
       INTEGER :: itau, iday
       REAL :: masse(iip1,jjp1,llm)
@@ -62,8 +92,22 @@
       REAL :: pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
       REAL :: w(ip1jmp1,llm)
-      REAL ::phystep,radpas,co2_ppm,solaire
+cIM   REAL ::phystep,co2_ppm,solaire
+      REAL ::phystep
+      INTEGER :: radpas
+       real zrel(iip1*jjp1),chmin,chmax
 
       CHARACTER*80 :: visu_file
       INTEGER :: visuid
+
+! pour la lecture du fichier masque ocean
+      integer :: nid_o2a
+      logical :: couple = .false.
+      INTEGER :: iml_omask, jml_omask
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
+      real, dimension(klon) :: ocemask_fi
+      integer :: isst(klon-2)
+      real zx_tmp_2d(iim,jjp1)
       !
       !   Constantes 
@@ -85,5 +129,6 @@
       !
 
-      CALL defrun_new(99,.TRUE.,clesphy0)
+!      CALL defrun_new(99,.TRUE.,clesphy0)
+      CALL conf_gcm( 99, .TRUE. , clesphy0 )
 
       dtvr   = daysec/FLOAT(day_step)
@@ -117,47 +162,120 @@
       ENDDO
       !
+
+
+C
+C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
+C utilise pour calculer les poids et pour assurer l'adequation entre les
+C fractions d'ocean vu par l'atmosphere et l'ocean. Sinon, on cree le masque 
+C a partir du fichier relief
+C
+
+      write(*,*)'Essai de lecture masque ocean'
+      iret = nf_open("o2a.nc", NF_NOWRITE, nid_o2a)
+      if (iret .ne. 0) then
+        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
+        write(*,*)'Run force'
+        varname = 'masque'
+        masque(:,:) = 0.0
+        CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0,
+     ,  jjm ,rlonu,rlatv , interbar )
+        WRITE(*,*) 'MASQUE construit : Masque'
+        WRITE(*,'(97I1)') nINT(masque(:,:))
+        call gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
+        WHERE (zmasq(1 : klon) .LT. EPSFRA)
+            zmasq(1 : klon) = 0.
+        END WHERE 
+        WHERE (1. - zmasq(1 : klon) .LT. EPSFRA)
+            zmasq(1 : klon) = 1.
+        END WHERE 
+      else
+        couple = .true.
+        iret = nf_close(nid_o2a)
+        call flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp
+     $    , nid_o2a)
+        if (iml_omask /= iim .or. jml_omask /= jjp1) then
+          write(*,*)'Dimensions non compatibles pour masque ocean'
+          write(*,*)'iim = ',iim,' iml_omask = ',iml_omask
+          write(*,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
+          stop
+        endif
+        ALLOCATE(lat_omask(iml_omask, jml_omask), stat=iret)
+        ALLOCATE(lon_omask(iml_omask, jml_omask), stat=iret)
+        ALLOCATE(dlon_omask(iml_omask), stat=iret)
+        ALLOCATE(dlat_omask(jml_omask), stat=iret)
+        ALLOCATE(ocemask(iml_omask, jml_omask), stat=iret)
+        ALLOCATE(ocetmp(iml_omask, jml_omask), stat=iret)
+        CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp
+     $    , lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
+        CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, 
+     $      ttm_tmp, 1, 1, ocetmp)
+        CALL flinclo(fid)
+        dlon_omask(1 : iml_omask) = lon_omask(1 : iml_omask, 1)
+        dlat_omask(1 : jml_omask) = lat_omask(1 , 1 : jml_omask)
+        ocemask = ocetmp
+        if (dlat_omask(1) < dlat_omask(jml_omask)) then
+          do j = 1, jml_omask
+            ocemask(:,j) = ocetmp(:,jml_omask-j+1)
+          enddo
+        endif 
+C
+C passage masque ocean a la grille physique
+C
+        write(*,*)'ocemask '
+        write(*,'(96i1)')int(ocemask)
+        ocemask_fi(1) = ocemask(1,1)
+        do j = 2, jjm
+          do i = 1, iim
+            ocemask_fi((j-2)*iim + i + 1) = ocemask(i,j)
+          enddo
+        enddo
+        ocemask_fi(klon) = ocemask(1,jjp1)
+        zmasq = 1. - ocemask_fi
+      endif
+
+      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
+
       varname = 'relief'
       ! This line needs to be replaced by a call to restget to get the values in the restart file
       orog(:,:) = 0.0
-       CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0)
+       CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0 ,
+     , jjm ,rlonu,rlatv , interbar, masque )
       !
       WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
-      WRITE(*,'(49I1)') INT(orog(:,:))
+!      WRITE(*,'(49I1)') INT(orog(:,:))
       !
       varname = 'rugosite'
       ! This line needs to be replaced by a call to restget to get the values in the restart file
       rugo(:,:) = 0.0
-       CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0)
+       CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0 ,
+     , jjm, rlonu,rlatv , interbar )
       !
       WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite' 
-      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
-      !
-      varname = 'masque'
-      ! This line needs to be replaced by a call to restget to get the values in the restart file
-      rugo(:,:) = 0.0
-       CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0)
-      !
-      WRITE(*,*) 'MASQUE construit : Masque'
-      WRITE(*,'(49I1)') INT(masque(:,:))
-      !
-      !
+!      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
+      !
+C
+C on initialise les sous surfaces
+C
+      pctsrf=0.
+c
       varname = 'psol'
       psol(:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0)
+      CALL startget(varname, iip1, jjp1, rlonv, rlatu, psol, 0.0 ,
+     , jjm ,rlonu,rlatv , interbar )
       !
       !  Compute here the pressure on the intermediate levels. One would expect that this is available in the GCM 
       !  anyway.
       !
-      WRITE(*,*) 'PSOL :', psol(10,20)
-      WRITE(*,*) ap(:), bp(:)
+!      WRITE(*,*) 'PSOL :', psol(10,20)
+!      WRITE(*,*) ap(:), bp(:)
       CALL pression(ip1jmp1, ap, bp, psol, p3d)
-      WRITE(*,*) 'P3D :', p3d(10,20,:)
+!      WRITE(*,*) 'P3D :', p3d(10,20,:)
       CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, workvar)
-      WRITE(*,*) 'PK:', pk(10,20,:)
+!      WRITE(*,*) 'PK:', pk(10,20,:)
       !
       !
       !
       prefkap =  preff  ** kappa
-      WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
+!      WRITE(*,*) 'unskap, cpp,  preff :', unskap, cpp,  preff
       DO l = 1, llm
         DO j=1,jjp1
@@ -168,25 +286,25 @@
       ENDDO
       !
-      WRITE(*,*) 'PLS :', pls(10,20,:)
+!      WRITE(*,*) 'PLS :', pls(10,20,:)
       !
       varname = 'surfgeo'
       phis(:,:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0)
-      phis = phis * 9.81
+      CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0 ,
+     , jjm ,rlonu,rlatv, interbar )
       !
       varname = 'u'
       uvent(:,:,:) = 0.0
       CALL startget(varname, iip1, jjp1, rlonu, rlatu, llm, pls,
-     . workvar, uvent, 0.0)
+     . workvar, uvent, 0.0, jjm ,rlonv, rlatv, interbar )
       !  
       varname = 'v'
       vvent(:,:,:) = 0.0
       CALL startget(varname, iip1, jjm, rlonv, rlatv, llm, pls,
-     . workvar, vvent, 0.0)
+     . workvar, vvent, 0.0, jjp1, rlonu, rlatu, interbar )
       !
       varname = 't'
       t3d(:,:,:) = 0.0
       CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
-     . workvar, t3d, 0.0)
+     . workvar, t3d, 0.0 , jjm, rlonu, rlatv , interbar )
       !
       WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
@@ -195,5 +313,5 @@
       tpot(:,:,:) = 0.0
       CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
-     . pk, tpot, 0.0)
+     . pk, tpot, 0.0 , jjm, rlonu, rlatv , interbar )
       !
       WRITE(*,*) 'T3D min,max:',minval(t3d(:,:,:)),
@@ -216,8 +334,9 @@
       varname = 'q'
       qd(:,:,:) = 0.0
+      q3d(:,:,:,:) = 0.0
       WRITE(*,*) 'QSAT min,max:',minval(qsat(:,:,:)),
      .                           maxval(qsat(:,:,:))
       CALL startget(varname, iip1, jjp1, rlonv, rlatu, llm, pls,
-     . qsat, qd, 0.0)
+     . qsat, qd, 0.0, jjm, rlonu, rlatv , interbar )
       q3d(:,:,:,1) = qd(:,:,:)
       !
@@ -225,55 +344,215 @@
       ! This line needs to be replaced by a call to restget to get the values in the restart file
       tsol(:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0)
+      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, tsol, 0.0,
+     .    jjm, rlonu, rlatv , interbar )
       !
       WRITE(*,*) 'TSOL construit :'
-      WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
+!      WRITE(*,'(48I3)') INT(TSOL(2:klon)-273)
       !
       varname = 'qsol'
       qsol(:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0)
+      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, qsol, 0.0,
+     .   jjm, rlonu, rlatv , interbar )
       !
       varname = 'snow'
       sn(:) = 0.0
-      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0)
+      CALL startget(varname, iip1, jjp1, rlonv, rlatu, klon, sn, 0.0,
+     .    jjm, rlonu, rlatv , interbar )
       !
       varname = 'rads'
       radsol(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,
+     .    jjm, rlonu, rlatv , interbar )
       !
       varname = 'deltat'
       deltat(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,deltat,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,deltat,0.0,
+     .     jjm, rlonu, rlatv , interbar )
       !
       varname = 'rugmer'
       rugmer(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0)
-      !
-      varname = 'agsno'
-      agesno(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,
+     .     jjm, rlonu, rlatv , interbar )
+      !
+!      varname = 'agesno'
+!      agesno(:) = 0.0
+!      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,agesno,0.0,
+!     .     jjm, rlonu, rlatv , interbar )
 
       varname = 'zmea'
       zmea(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,
+     .     jjm, rlonu, rlatv , interbar )
+
       varname = 'zstd'
       zstd(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,
+     .     jjm, rlonu, rlatv , interbar )
       varname = 'zsig'
       zsig(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,
+     .     jjm, rlonu, rlatv , interbar )
       varname = 'zgam'
       zgam(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,
+     .     jjm, rlonu, rlatv , interbar )
       varname = 'zthe'
       zthe(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,
+     .     jjm, rlonu, rlatv , interbar )
       varname = 'zpic'
       zpic(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,
+     .     jjm, rlonu, rlatv , interbar )
       varname = 'zval'
       zval(:) = 0.0
-      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0)
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,
+     .     jjm, rlonu, rlatv , interbar )
+c
       rugsrel(:) = 0.0
+      IF(ok_orodr)  THEN
+        DO i = 1, iip1* jjp1
+         rugsrel(i) = MAX( 1.e-05, zstd(i)* zsig(i) /2. )
+        ENDDO
+      ENDIF
+
+
+C
+C lecture du fichier glace de terre pour fixer la fraction de terre 
+C et de glace de terre
+C
+      CALL flininfo("landiceref.nc", iml_lic, jml_lic,llm_tmp, ttm_tmp
+     $    , fid)
+      ALLOCATE(lat_lic(iml_lic, jml_lic), stat=iret)
+      ALLOCATE(lon_lic(iml_lic, jml_lic), stat=iret)
+      ALLOCATE(dlon_lic(iml_lic), stat=iret)
+      ALLOCATE(dlat_lic(jml_lic), stat=iret)
+      ALLOCATE(fraclic(iml_lic, jml_lic), stat=iret)
+      CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp
+     $    , lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
+      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp
+     $    , 1, 1, fraclic)
+      CALL flinclo(fid)
+C
+C interpolation sur la grille T du modele
+C
+      WRITE(*,*) 'dimensions de landice iml_lic, jml_lic : ', 
+     $    iml_lic, jml_lic
+c
+C sil les coordonnees sont en degres, on les transforme
+C
+      IF( MAXVAL( lon_lic(:,:) ) .GT. 2.0 * asin(1.0) )  THEN
+          lon_lic(:,:) = lon_lic(:,:) * 2.0* ASIN(1.0) / 180.
+      ENDIF 
+      IF( maxval( lat_lic(:,:) ) .GT. 2.0 * asin(1.0)) THEN 
+          lat_lic(:,:) = lat_lic(:,:) * 2.0 * asin(1.0) / 180.
+      ENDIF 
+
+      dlon_lic(1 : iml_lic) = lon_lic(1 : iml_lic, 1)
+      dlat_lic(1 : jml_lic) = lat_lic(1 , 1 : jml_lic) 
+C
+      CALL grille_m(iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic
+     $    ,iim, jjp1,
+     $    rlonv, rlatu, flic_tmp(1 : iim, 1 : jjp1))
+c$$$      flic_tmp(1 : iim, 1 : jjp1) = champint(1: iim, 1 : jjp1)
+      flic_tmp(iip1, 1 : jjp1) = flic_tmp(1 , 1 : jjp1)
+C
+C passage sur la grille physique
+C
+      CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp,
+     $    pctsrf(1:klon, is_lic))
+C adequation avec le maque terre/mer
+c      zmasq(157) = 0.
+      WHERE (pctsrf(1 : klon, is_lic) .LT. EPSFRA ) 
+          pctsrf(1 : klon, is_lic) = 0. 
+      END WHERE
+      WHERE (zmasq( 1 : klon) .LT. EPSFRA) 
+          pctsrf(1 : klon, is_lic) = 0.
+      END WHERE 
+      pctsrf(1 : klon, is_ter) = zmasq(1 : klon)
+      DO ji = 1, klon
+        IF (zmasq(ji) .GT. EPSFRA) THEN 
+            IF ( pctsrf(ji, is_lic) .GE. zmasq(ji)) THEN
+                pctsrf(ji, is_lic) = zmasq(ji)
+                pctsrf(ji, is_ter) = 0.
+            ELSE 
+                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
+                IF (pctsrf(ji,is_ter) .LT. EPSFRA) THEN
+                    pctsrf(ji,is_ter) = 0.
+                    pctsrf(ji, is_lic) = zmasq(ji)
+                ENDIF 
+            ENDIF 
+        ENDIF 
+      END DO 
+C
+C sous surface ocean et glace de mer (pour demarrer on met glace de mer a 0)
+C
+      pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon))
+
+
+      WHERE (pctsrf(1 : klon, is_oce) .LT. EPSFRA)
+          pctsrf(1 : klon, is_oce) = 0.
+      END WHERE 
+
+      if (couple) pctsrf(1 : klon, is_oce) = ocemask_fi(1 : klon)
+
+      isst = 0
+      where (pctsrf(2:klon-1,is_oce) >0.) isst = 1
+C
+C verif que somme des sous surface = 1
+C
+      ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf), dim = 2)) - 1.0 ) 
+     $    .GT. EPSFRA)
+      IF (ji .NE. 0) THEN
+          WRITE(*,*) 'pb repartition sous maille pour ',ji,' points'
+      ENDIF 
+
+!      where (pctsrf(1:klon, is_ter) >= .5) 
+!        pctsrf(1:klon, is_ter) = 1.
+!        pctsrf(1:klon, is_oce) = 0.
+!        pctsrf(1:klon, is_sic) = 0.
+!        pctsrf(1:klon, is_lic) = 0.
+!        zmasq = 1.
+!      endwhere
+!      where (pctsrf(1:klon, is_lic) >= .5) 
+!        pctsrf(1:klon, is_ter) = 0.
+!        pctsrf(1:klon, is_oce) = 0.
+!        pctsrf(1:klon, is_sic) = 0.
+!        pctsrf(1:klon, is_lic) = 1.
+!        zmasq = 1.
+!      endwhere
+!      where (pctsrf(1:klon, is_oce) >= .5) 
+!        pctsrf(1:klon, is_ter) = 0.
+!        pctsrf(1:klon, is_oce) = 1.
+!        pctsrf(1:klon, is_sic) = 0.
+!        pctsrf(1:klon, is_lic) = 0.
+!        zmasq = 0.
+!      endwhere
+!      where (pctsrf(1:klon, is_sic) >= .5) 
+!        pctsrf(1:klon, is_ter) = 0.
+!        pctsrf(1:klon, is_oce) = 0.
+!        pctsrf(1:klon, is_sic) = 1.
+!        pctsrf(1:klon, is_lic) = 0.
+!        zmasq = 0.
+!      endwhere
+!      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
+C
+C verif que somme des sous surface = 1
+C
+!      ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf), dim = 2)) - 1.0 ) 
+!     $    .GT. EPSFRA)
+!      IF (ji .NE. 0) THEN
+!          WRITE(*,*) 'pb repartition sous maille pour ',ji,' points'
+!     ENDIF 
+
+      CALL gr_fi_ecrit(1,klon,iim,jjp1,zmasq,zx_tmp_2d)
+      write(*,*)'zmasq = '
+      write(*,'(96i1)')nint(zx_tmp_2d)
+      call gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
+      WRITE(*,*) 'MASQUE construit : Masque'
+      WRITE(*,'(97I1)') nINT(masque(:,:))
+
+
+
 C Calcul intermediaire
 c 
@@ -283,18 +562,16 @@
       print *,' ALPHAX ',alphax
 
-      IF( alphax.NE.0. )   THEN
-       DO  l = 1, llm
-         DO  i    = 1, iim
+      DO  l = 1, llm
+        DO  i    = 1, iim
           xppn(i) = aire( i, 1   ) * masse(  i     ,  1   , l )
           xpps(i) = aire( i,jjp1 ) * masse(  i     , jjp1 , l )
-         ENDDO
+        ENDDO
           xpn      = SUM(xppn)/apoln
           xps      = SUM(xpps)/apols
-         DO i   = 1, iip1
+        DO i   = 1, iip1
           masse(   i   ,   1     ,  l )   = xpn
           masse(   i   ,   jjp1  ,  l )   = xps
-         ENDDO
-       ENDDO
-      ENDIF
+        ENDDO
+      ENDDO
       q3d(iip1,:,:,:) = q3d(1,:,:,:)
       phis(iip1,:) = phis(1,:)
@@ -307,4 +584,6 @@
       print*,'sortie inidissip'
       itau = 0
+      itau_dyn = 0
+      itau_phy = 0
       iday = dayref +itau/day_step
       time = FLOAT(itau-(iday-dayref)*day_step)/day_step
@@ -314,4 +593,7 @@
        iday = iday + 1
       ENDIF
+      day_ref = dayref
+      annee_ref = anneeref
+
       CALL geopot  ( ip1jmp1, tpot  , pk , pks,  phis  , phi   )
       print*,'sortie geopot'
@@ -320,5 +602,5 @@
      *                phi,w, pbaru,pbarv,time+iday-dayref   )
        print*,'sortie caldyn0'     
-      CALL dynredem0("start.nc",dayref,anneeref,phis,nqmx)
+      CALL dynredem0("start.nc",dayref,phis,nqmx)
       print*,'sortie dynredem0'
       CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,nqmx,masse ,
@@ -328,15 +610,74 @@
 C Ecriture etat initial physique
 C
+      write(*,*)'phystep ',dtvr,iphysiq,nbapp_rad
       phystep   = dtvr * FLOAT(iphysiq)
       radpas    = NINT (86400./phystep/ FLOAT(nbapp_rad) )
-      co2_ppm   = 330.0
-      solaire   = 1370.0
-
-      call physdem(lonfi, latfi, phystep,radpas,co2_ppm,
-     .                   solaire,tsol, qsol,
-     .                   sn, radsol, deltat, rugmer,
-     .                   agesno, zmea, zstd, zsig,
-     .                   zgam, zthe, zpic, zval,
-     .                   rugsrel)
+      write(*,*)'phystep =', phystep, radpas
+cIM : lecture de co2_ppm & solaire ds physiq.def
+c     co2_ppm   = 348.0
+c     solaire   = 1365.0
+
+c
+c Initialisation 
+c tsol, qsol, sn,albe, evap,tsoil,rain_fall, snow_fall,solsw, sollw,frugs
+c
+      tsolsrf(:,is_ter) = tsol
+      tsolsrf(:,is_lic) = tsol
+      tsolsrf(:,is_oce) = tsol
+      tsolsrf(:,is_sic) = tsol
+      snsrf(:,is_ter) = sn
+      snsrf(:,is_lic) = sn
+      snsrf(:,is_oce) = sn
+      snsrf(:,is_sic) = sn
+      albe(:,is_ter) = 0.08
+      albe(:,is_lic) = 0.6
+      albe(:,is_oce) = 0.5
+      albe(:,is_sic) = 0.6
+      alblw(:,is_ter) = albe(:,is_ter)
+      alblw(:,is_lic) = albe(:,is_lic)
+      alblw(:,is_oce) = albe(:,is_oce)
+      alblw(:,is_sic) = albe(:,is_sic)
+
+      evap(:,:) = 0.
+C     vapeur d'eau a la surface =- vapeur d'eau premier niveau
+      do n = 1, nbsrf 
+        DO j=2,jjm
+          DO i =1, iim
+            qsurf((j-2)*iim+1+i,n)=q3d(i,j,1,1)
+          END DO 
+        END DO
+        qsurf(1,n)=q3d(1,1,1,1)  ! pole nord 
+        qsurf(klon,n)=q3d(1,jjp1,1,1)  ! pole sud
+      END DO 
+      qsol(:) = 150.
+      do i = 1, nbsrf
+        do j = 1, nsoilmx
+          tsoil(:,j,i) = tsol
+        enddo
+      enddo
+      rain_fall = 0.; snow_fall = 0.
+      solsw = 165.
+      sollw = -53.
+      t_ancien = 273.15
+      q_ancien = 0.
+      agesno = 0.
+      deltat = 0.
+      frugs(1:klon,is_oce) = rugmer(1:klon)
+      frugs(1:klon,is_ter) = MAX(1.0e-05, zstd(1:klon)*zsig(1:klon)/2.0)
+      frugs(1:klon,is_lic) = MAX(1.0e-05, zstd(1:klon)*zsig(1:klon)/2.0)
+      frugs(1:klon,is_sic) = 0.002
+      fder = 0.0
+      clwcon = 0.0
+      rnebcon = 0.0
+      ratqs = 0.0
+
+cIM   call phyredem("startphy.nc",phystep,radpas, co2_ppm, solaire,
+      call phyredem("startphy.nc",phystep,radpas,
+     $    latfi, lonfi, pctsrf, tsolsrf, tsoil, deltat, qsurf, qsol, 
+     $    snsrf, albe, alblw,
+     $    evap, rain_fall, snow_fall, solsw, sollw, fder,
+     $    radsol, frugs,  agesno, 
+     $    zmea, zstd, zsig, zgam, zthe, zpic, zval, rugsrel, 
+     $    t_ancien, q_ancien, rnebcon, ratqs, clwcon)
 
 C     Sortie Visu pour les champs dynamiques
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/exner_hyb.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/exner_hyb.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/exner_hyb.F	(revision 497)
@@ -53,20 +53,18 @@
 c
       DO   ij  = 1, ngrid
-       pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
       ENDDO
 
-      IF( alphax.NE.0. )   THEN
-        DO  ij   = 1, iim
-         ppn(ij) = aire(   ij   ) * pks(  ij     )
-         pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
-        ENDDO
-         xpn      = SSUM(iim,ppn,1) /apoln
-         xps      = SSUM(iim,pps,1) /apols
+      DO  ij   = 1, iim
+        ppn(ij) = aire(   ij   ) * pks(  ij     )
+        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
+      ENDDO
+      xpn      = SSUM(iim,ppn,1) /apoln
+      xps      = SSUM(iim,pps,1) /apols
 
-        DO ij   = 1, iip1
-         pks(   ij     )  =  xpn
-         pks( ij+ip1jm )  =  xps
-        ENDDO
-      ENDIF
+      DO ij   = 1, iip1
+        pks(   ij     )  =  xpn
+        pks( ij+ip1jm )  =  xps
+      ENDDO
 c
 c
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/extrapol.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/extrapol.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/extrapol.F	(revision 497)
@@ -0,0 +1,198 @@
+C
+C $Header$
+C
+      SUBROUTINE extrapol (pfild, kxlon, kylat, pmask,
+     .                   norsud, ldper, knbor, pwork)
+      IMPLICIT none
+c
+c OASIS routine (Adaptation: Laurent Li, le 14 mars 1997)
+c Fill up missed values by using the neighbor points
+c
+      INTEGER kxlon, kylat ! longitude and latitude dimensions (Input)
+      INTEGER knbor ! minimum neighbor number (Input)
+      LOGICAL norsud ! True if field is from North to South (Input)
+      LOGICAL ldper ! True if take into account the periodicity (Input)
+      REAL pmask ! mask value (Input)
+      REAL pfild(kxlon,kylat) ! field to be extrapolated (Input/Output)
+      REAL pwork(kxlon,kylat) ! working space
+c
+      REAL zwmsk
+      INTEGER incre, idoit, i, j, k, inbor, ideb, ifin, ilon, jlat
+      INTEGER ix(9), jy(9) ! index arrays for the neighbors coordinates
+      REAL zmask(9)
+C
+C  We search over the eight closest neighbors
+C
+C            j+1  7  8  9
+C              j  4  5  6    Current point 5 --> (i,j)
+C            j-1  1  2  3
+C                i-1 i i+1
+c
+c
+      IF (norsud) THEN
+         DO j = 1, kylat
+         DO i = 1, kxlon
+            pwork(i,j) = pfild(i,kylat-j+1)
+         ENDDO
+         ENDDO
+         DO j = 1, kylat
+         DO i = 1, kxlon
+            pfild(i,j) = pwork(i,j)
+         ENDDO
+         ENDDO
+      ENDIF
+c
+      incre = 0
+c
+      DO j = 1, kylat
+      DO i = 1, kxlon
+         pwork(i,j) = pfild(i,j)
+      ENDDO
+      ENDDO
+c
+C* To avoid problems in floating point tests
+      zwmsk = pmask - 1.0
+c
+200   CONTINUE
+      incre = incre + 1
+      DO 99999 j = 1, kylat
+      DO 99999 i = 1, kxlon
+      IF (pfild(i,j).GT. zwmsk) THEN
+         pwork(i,j) = pfild(i,j)
+         inbor = 0
+         ideb = 1
+         ifin = 9
+C
+C* Fill up ix array
+         ix(1) = MAX (1,i-1)
+         ix(2) = i
+         ix(3) = MIN (kxlon,i+1)
+         ix(4) = MAX (1,i-1)
+         ix(5) = i
+         ix(6) = MIN (kxlon,i+1)
+         ix(7) = MAX (1,i-1)
+         ix(8) = i
+         ix(9) = MIN (kxlon,i+1)
+C
+C* Fill up iy array
+         jy(1) = MAX (1,j-1)
+         jy(2) = MAX (1,j-1)
+         jy(3) = MAX (1,j-1)
+         jy(4) = j
+         jy(5) = j
+         jy(6) = j
+         jy(7) = MIN (kylat,j+1)
+         jy(8) = MIN (kylat,j+1)
+         jy(9) = MIN (kylat,j+1)
+C
+C* Correct latitude bounds if southernmost or northernmost points
+         IF (j .EQ. 1) ideb = 4
+         IF (j .EQ. kylat) ifin = 6
+C
+C* Account for periodicity in longitude
+C
+         IF (ldper) THEN 
+            IF (i .EQ. kxlon) THEN
+               ix(3) = 1
+               ix(6) = 1
+               ix(9) = 1
+            ELSE IF (i .EQ. 1) THEN
+               ix(1) = kxlon
+               ix(4) = kxlon
+               ix(7) = kxlon
+            ENDIF
+         ELSE
+            IF (i .EQ. 1) THEN
+               ix(1) = i
+               ix(2) = i + 1
+               ix(3) = i
+               ix(4) = i + 1
+               ix(5) = i
+               ix(6) = i + 1
+            ENDIF 
+            IF (i .EQ. kxlon) THEN
+               ix(1) = i -1
+               ix(2) = i
+               ix(3) = i - 1
+               ix(4) = i
+               ix(5) = i - 1
+               ix(6) = i
+            ENDIF
+C
+            IF (i .EQ. 1 .OR. i .EQ. kxlon) THEN 
+               jy(1) = MAX (1,j-1)
+               jy(2) = MAX (1,j-1)
+               jy(3) = j
+               jy(4) = j
+               jy(5) = MIN (kylat,j+1)
+               jy(6) = MIN (kylat,j+1)
+C
+               ideb = 1
+               ifin = 6
+               IF (j .EQ. 1) ideb = 3
+               IF (j .EQ. kylat) ifin = 4
+            ENDIF
+         ENDIF ! end for ldper test
+C
+C* Find unmasked neighbors
+C
+         DO 230 k = ideb, ifin
+            zmask(k) = 0.
+            ilon = ix(k)
+            jlat = jy(k)
+            IF (pfild(ilon,jlat) .LT. zwmsk) THEN
+               zmask(k) = 1.
+               inbor = inbor + 1
+            ENDIF
+ 230     CONTINUE
+C
+C* Not enough points around point P are unmasked; interpolation on P 
+C  will be done in a future call to extrap.
+C
+         IF (inbor .GE. knbor) THEN
+            pwork(i,j) = 0.
+            DO k = ideb, ifin
+               ilon = ix(k)
+               jlat = jy(k)
+               pwork(i,j) = pwork(i,j)
+     $                      + pfild(ilon,jlat) * zmask(k)/FLOAT(inbor)
+            ENDDO
+         ENDIF
+C
+      ENDIF
+99999 CONTINUE
+C
+C*    3. Writing back unmasked field in pfild
+C        ------------------------------------
+C
+C* pfild then contains:
+C     - Values which were not masked
+C     - Interpolated values from the inbor neighbors
+C     - Values which are not yet interpolated
+C
+      idoit = 0
+      DO j = 1, kylat
+      DO i = 1, kxlon
+         IF (pwork(i,j) .GT. zwmsk) idoit = idoit + 1
+         pfild(i,j) = pwork(i,j)
+      ENDDO
+      ENDDO
+c
+      IF (idoit .ne. 0) GOTO 200
+ccc      PRINT*, "Number of extrapolation steps incre =", incre
+c
+      IF (norsud) THEN
+         DO j = 1, kylat
+         DO i = 1, kxlon
+            pwork(i,j) = pfild(i,kylat-j+1)
+         ENDDO
+         ENDDO
+         DO j = 1, kylat
+         DO i = 1, kxlon
+            pfild(i,j) = pwork(i,j)
+         ENDDO
+         ENDDO
+      ENDIF
+c
+      RETURN
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fluxstoke.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/fluxstoke.F	(revision 3)
+++ 	(revision )
@@ -1,149 +1,0 @@
-      SUBROUTINE fluxstoke(pbaru,pbarv,masse,teta,phi,phis)
-c
-c     Auteur :  F. Hourdin
-c
-c
-ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
-c
-      IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "tracstoke.h"
-
-
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
-      REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
-      REAL phis(ip1jmp1)
-
-      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
-      REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
-
-      REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
-
-      REAL pbarvst(iip1,jjp1,llm)
-
-
-      INTEGER iadvtr 
-      INTEGER ij,l,irec,i,j
- 
-      SAVE iadvtr, massem,pbaruc,pbarvc,irec
-      SAVE phic,tetac
-      logical first
-      save first
-      data first/.true./
-      DATA iadvtr/0/
-
-      if(first) then
-#ifdef CRAY
-         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
-#endif
-         open(47,file='fluxmass',form='unformatted',
-     s        access='direct',recl=4*(6*ijp1llm))
-         irec=1
-         first=.false.
-
-         open(77,file='fluxmass.ctl',status='unknown',form='formatted')
-
-      endif
-
-
-      IF(iadvtr.EQ.0) THEN
-         CALL initial0(ijp1llm,phic)
-         CALL initial0(ijp1llm,tetac)
-         CALL initial0(ijp1llm,pbaruc)
-         CALL initial0(ijmllm,pbarvc)
-      ENDIF
-
-c   accumulation des flux de masse horizontaux
-      DO l=1,llm
-         DO ij = 1,ip1jmp1
-            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
-            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
-            phic(ij,l) = phic(ij,l) + phi(ij,l)
-         ENDDO
-         DO ij = 1,ip1jm
-            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
-         ENDDO
-      ENDDO
-
-c   selection de la masse instantannee des mailles avant le transport.
-      IF(iadvtr.EQ.0) THEN
-         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
-      ENDIF
-
-      iadvtr   = iadvtr+1
-
-
-c   Test pour savoir si on advecte a ce pas de temps
-      IF ( iadvtr.EQ.istdyn ) THEN
-
-c    normalisation
-      DO l=1,llm
-         DO ij = 1,ip1jmp1
-            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
-            tetac(ij,l) = tetac(ij,l)/float(istdyn)
-            phic(ij,l) = phic(ij,l)/float(istdyn)
-         ENDDO
-         DO ij = 1,ip1jm
-            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
-         ENDDO
-      ENDDO
-
-c   traitement des flux de masse avant advection.
-c     1. calcul de w
-c     2. groupement des mailles pres du pole.
-
-        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
-
-        do l=1,llm
-           do j=1,jjm
-              do i=1,iip1
-                 pbarvst(i,j,l)=pbarvg(i,j,l)
-              enddo
-           enddo
-           do i=1,iip1
-              pbarvst(i,jjp1,l)=0.
-           enddo
-        enddo
-
-         iadvtr=0
-
-         irec=irec+1
-         write(47,rec=1) float(irec),dtvr,float(istdyn),
-     s    float(iim),float(jjm),float(llm),rlonu,rlonv,rlatu,rlatv
-     s    ,aire,phis
-         write(47,rec=irec) massem,pbarug,pbarvst,wg,tetac,phic
-
-c   on reinitialise a zero les flux de masse cumules.
-
-      write(77,'(a4,2x,a40)')
-     &       'DSET ','^fluxmass'
-
-      write(77,'(a12)') 'UNDEF 1.0E30'
-      write(77,'(a5,1x,a40)') 'TITLE ','Titre a voir'
-      call formcoord(77,iip1,rlonv,180./pi,.false.,'XDEF')
-      call formcoord(77,jjp1,rlatu,180./pi,.true.,'YDEF')
-      call formcoord(77,llm,presnivs,1.,.false.,'ZDEF')
-      write(77,'(a4,i10,a30)')
-     &       'TDEF ',irec,' LINEAR 02JAN1987 1DY '
-      write(77,'(a4,2x,i5)') 'VARS',6
-      write(77,1000) 'masse',llm,99,'masse    '
-      write(77,1000) 'pbaru',llm,99,'pbaru    '
-      write(77,1000) 'pbarv',llm,99,'pbarv    '
-      write(77,1000) 'w    ',llm,99,'w        '
-      write(77,1000) 'teta ',llm,99,'teta     '
-      write(77,1000) 'phi  ',llm,99,'phi      '
-      write(77,'(a7)') 'ENDVARS'
-
-1000  format(a5,3x,i4,i3,1x,a39)
-
-
-
-      ENDIF ! if iadvtr.EQ.istdyn
-
-      RETURN
-      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fluxstokenc.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fluxstokenc.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fluxstokenc.F	(revision 497)
@@ -0,0 +1,155 @@
+      SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
+     . time_step,itau )
+
+       USE IOIPSL
+c
+c     Auteur :  F. Hourdin
+c
+c
+ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "tracstoke.h"
+#include "temps.h"
+
+      REAL time_step,t_wrt, t_ops
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
+      REAL phis(ip1jmp1)
+
+      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
+      REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
+
+      REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
+
+      REAL pbarvst(iip1,jjp1,llm),zistdyn
+	real dtcum
+
+      INTEGER iadvtr,ndex(1) 
+      integer nscal
+      real tst(1),ist(1),istp(1)
+      INTEGER ij,l,irec,i,j,itau
+      INTEGER fluxid, fluxvid,fluxdid
+ 
+      SAVE iadvtr, massem,pbaruc,pbarvc,irec
+      SAVE phic,tetac
+      logical first
+      save first
+      data first/.true./
+      DATA iadvtr/0/
+
+      if(first) then
+
+	CALL initfluxsto( 'fluxstoke',
+     .  time_step,istdyn* time_step,istdyn* time_step,
+     . nqmx, fluxid,fluxvid,fluxdid) 
+	
+	ndex(1) = 0
+        call histwrite(fluxid, 'phis', 1, phis, iip1*jjp1, ndex)
+        call histwrite(fluxid, 'aire', 1, aire, iip1*jjp1, ndex)
+	
+	ndex(1) = 0
+        nscal = 1
+        tst(1) = time_step
+        call histwrite(fluxdid, 'dtvr', 1, tst, nscal, ndex)
+        ist(1)=istdyn
+        call histwrite(fluxdid, 'istdyn', 1, ist, nscal, ndex)
+        istp(1)= istphy
+        call histwrite(fluxdid, 'istphy', 1, istp, nscal, ndex)
+	
+	first = .false.
+
+      endif
+
+
+      IF(iadvtr.EQ.0) THEN
+         CALL initial0(ijp1llm,phic)
+         CALL initial0(ijp1llm,tetac)
+         CALL initial0(ijp1llm,pbaruc)
+         CALL initial0(ijmllm,pbarvc)
+      ENDIF
+
+c   accumulation des flux de masse horizontaux
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
+            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
+            phic(ij,l) = phic(ij,l) + phi(ij,l)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
+         ENDDO
+      ENDDO
+
+c   selection de la masse instantannee des mailles avant le transport.
+      IF(iadvtr.EQ.0) THEN
+         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
+      ENDIF
+
+      iadvtr   = iadvtr+1
+
+
+c   Test pour savoir si on advecte a ce pas de temps
+      IF ( iadvtr.EQ.istdyn ) THEN
+c    normalisation
+      DO l=1,llm
+         DO ij = 1,ip1jmp1
+            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
+            tetac(ij,l) = tetac(ij,l)/float(istdyn)
+            phic(ij,l) = phic(ij,l)/float(istdyn)
+         ENDDO
+         DO ij = 1,ip1jm
+            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
+         ENDDO
+      ENDDO
+
+c   traitement des flux de masse avant advection.
+c     1. calcul de w
+c     2. groupement des mailles pres du pole.
+
+        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
+
+        do l=1,llm
+           do j=1,jjm
+              do i=1,iip1
+                 pbarvst(i,j,l)=pbarvg(i,j,l)
+              enddo
+           enddo
+           do i=1,iip1
+              pbarvst(i,jjp1,l)=0.
+           enddo
+        enddo
+
+         iadvtr=0
+	Print*,'ITAU auqel on stoke les fluxmasses',itau
+	
+	call histwrite(fluxid, 'masse', itau, massem,
+     .               iip1*jjp1*llm, ndex)
+	
+	call histwrite(fluxid, 'pbaru', itau, pbarug,
+     .               iip1*jjp1*llm, ndex)
+	
+	call histwrite(fluxvid, 'pbarv', itau, pbarvg,
+     .               iip1*jjm*llm, ndex)
+	
+        call histwrite(fluxid, 'w' ,itau, wg, 
+     .             iip1*jjp1*llm, ndex) 
+	
+	call histwrite(fluxid, 'teta' ,itau, tetac, 
+     .             iip1*jjp1*llm, ndex) 
+	
+	call histwrite(fluxid, 'phi' ,itau, phic, 
+     .             iip1*jjp1*llm, ndex) 
+	
+C
+
+      ENDIF ! if iadvtr.EQ.istdyn
+
+      RETURN
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fxhyp.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/fxhyp.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fxhyp.F	(revision 497)
@@ -1,4 +1,8 @@
+c
+c $Header$
+c
        SUBROUTINE fxhyp ( xzoomdeg,grossism,dzoom,tau ,
-     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025)
+     , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,
+     , champmin,champmax                                               )
 
 c      Auteur :  P. Le Van 
@@ -11,9 +15,19 @@
 c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois,etc.)
 c     dzoom  etant  la distance totale de la zone du zoom
-c     tau  la transition ,   normalement  = 1  .
-c
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom
+c
+c    On doit avoir grossism x dzoom <  pi ( radians )   , en longitude.
+c   ********************************************************************
+
 
        INTEGER nmax, nmax2
-       PARAMETER (  nmax = 50000, nmax2 = 2*nmax )
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
+c
+       LOGICAL scal180
+       PARAMETER ( scal180 = .TRUE. )
+
+c      scal180 = .TRUE.  si on veut avoir le premier point scalaire pour   
+c      une grille reguliere ( grossism = 1.,tau=0.,clon=0. ) a -180. degres.
+c      sinon scal180 = .FALSE.
 
 #include "dimensions.h"
@@ -23,63 +37,133 @@
 c
        REAL xzoomdeg,dzoom,tau,grossism
+
+c    ......   arguments  de  sortie  ......
+
        REAL rlonm025(iip1),xprimm025(iip1),rlonv(iip1),xprimv(iip1),
      ,  rlonu(iip1),xprimu(iip1),rlonp025(iip1),xprimp025(iip1)
 
-c    ......   arguments  de  sortie  ......
-c
-       REAL xlon(iip1),xprimm(iip1),xuv
-       REAL xtild(0:nmax2)
-       REAL fhyp(0:nmax),ffdx(0:nmax),beta,Xprimt(0:nmax2)
-       REAL Xf(0:nmax2),xxpr(0:nmax2)
-       REAL xvrai(iip1),xxprim(iip1) 
-       REAL pi,depi,epsilon,xzoom
-       INTEGER i,it,ik,iter,ii,idif
-       REAL xi,xo1,xint,xmoy,xlon2,fxm,Xprimin
-       REAL champmin,champmax
+c     .... variables locales  ....
+c
+       REAL*8 xlon(iip1),xprimm(iip1),xuv
+       REAL*8 xtild(0:nmax2)
+       REAL*8 fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)
+       REAL*8 Xf(0:nmax2),xxpr(0:nmax2)
+       REAL*8 xvrai(iip1),xxprim(iip1) 
+       REAL*8 pi,depi,epsilon,xzoom,fa,fb
+       REAL*8 Xf1, Xfi , a0,a1,a2,a3,xi2
+       INTEGER i,it,ik,iter,ii,idif,ii1,ii2
+       REAL*8 xi,xo1,xmoy,xlon2,fxm,Xprimin
+       REAL*8 champmin,champmax,decalx
        INTEGER is2
        SAVE is2
-       REAL dlon1(iip1),dlon2(iip1),dlon3(iip1)
+
+       REAL*8 heavyside
+       EXTERNAL coefpoly,heavyside
 
        pi       = 2. * ASIN(1.)
        depi     = 2. * pi
-       epsilon  = 1.e-6
+       epsilon  = 1.e-3
        xzoom    = xzoomdeg * pi/180. 
-
-
+c
+           decalx   = .75
+       IF( grossism.EQ.1..AND.scal180 )  THEN
+           decalx   = 1.
+       ENDIF
+
+       WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx
+c
+       IF( dzoom.LT.1.)  THEN
+         dzoom = dzoom * depi
+       ELSEIF( dzoom.LT. 25. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fxhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzoom * pi/180.
+       ENDIF
+
+       WRITE(6,*) ' xzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) xzoom,grossism,tau,dzoom
 
        DO i = 0, nmax2 
-         xtild(i) = FLOAT(i) /nmax2
-        IF( xtild(i).EQ. 0.5 )  xtild(i) = xtild(i) + 1.e-6
-       ENDDO
-
-       DO i = 1, nmax
-        fhyp(i) = TANH ( ( xtild(i) - 0.5*(1.- dzoom) )          /
-     ,                 ( tau * xtild(i) * ( 0.5 -xtild(i))) )
-       ENDDO
-
-        fhyp(   0  ) = - 1.
-        fhyp( nmax ) =   1.
+        xtild(i) = - pi + FLOAT(i) * depi /nmax2
+       ENDDO
+
+       DO i = nmax, nmax2
+
+       fa  = tau*  ( dzoom/2.  - xtild(i) )
+       fb  = xtild(i) *  ( pi - xtild(i) )
+
+         IF( 200.* fb .LT. - fa )   THEN
+           fhyp ( i) = - 1.
+         ELSEIF( 200. * fb .LT. fa ) THEN
+           fhyp ( i) =   1.
+         ELSE
+            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
+                IF(   200.*fb + fa.LT.1.e-10 )  THEN
+                    fhyp ( i ) = - 1.
+                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
+                    fhyp ( i )  =   1.
+                ENDIF
+            ELSE
+                    fhyp ( i )  =  TANH ( fa/fb )
+            ENDIF
+         ENDIF
+        IF ( xtild(i).EQ. 0. )  fhyp(i) =  1.
+        IF ( xtild(i).EQ. pi )  fhyp(i) = -1.
+
+       ENDDO
 
 cc  ....  Calcul  de  beta  ....
-c
-       ffdx( 0 ) = 0.
-
-       DO i = 1, nmax
-        xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
-        fxm     = TANH ( ( xmoy - 0.5 * ( 1. - dzoom ) )    /
-     ,                 ( tau * xmoy * ( 0.5 -xmoy)) )
-        ffdx(i) = ffdx(i-1) + fxm * ( xtild(i) - xtild(i-1) )
-       ENDDO
-
-        beta  = ( grossism * ffdx(nmax) - 0.5 ) / ( ffdx(nmax) - 0.5 )
+
+       ffdx = 0.
+
+       DO i = nmax +1,nmax2
+
+       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
+       fa  = tau*  ( dzoom/2.  - xmoy )
+       fb  = xmoy *  ( pi - xmoy )
+
+       IF( 200.* fb .LT. - fa )   THEN
+         fxm = - 1.
+       ELSEIF( 200. * fb .LT. fa ) THEN
+         fxm =   1.
+       ELSE
+            IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN
+                IF(   200.*fb + fa.LT.1.e-10 )  THEN
+                    fxm   = - 1.
+                ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN
+                    fxm   =   1.
+                ENDIF
+            ELSE
+                    fxm   =  TANH ( fa/fb )
+            ENDIF
+       ENDIF
+
+       IF ( xmoy.EQ. 0. )  fxm  =  1.
+       IF ( xmoy.EQ. pi )  fxm  = -1.
+
+       ffdx = ffdx + fxm * ( xtild(i) - xtild(i-1) )
+
+       ENDDO
+
+        beta  = ( grossism * ffdx - pi ) / ( ffdx - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fxhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',
+     , ' et relancer ! ***  '
+        CALL ABORT
+       ENDIF
 c
 c   .....  calcul  de  Xprimt   .....
 c
        
-       DO i = 0, nmax
+       DO i = nmax, nmax2
         Xprimt(i) = beta  + ( grossism - beta ) * fhyp(i)
        ENDDO
 c   
-       DO i = 0, nmax
+       DO i =  nmax+1, nmax2
         Xprimt( nmax2 - i ) = Xprimt( i )
        ENDDO
@@ -88,14 +172,28 @@
 c   .....  Calcul  de  Xf     ........
 
-        Xf(0) = 0.
-       DO i = 1, nmax
-        xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
-        fxm     = TANH ( ( xmoy - 0.5 * ( 1. - dzoom ) )    /
-     ,                 ( tau * xmoy * ( 0.5 -xmoy)) )
-        xxpr(i)    = beta + ( grossism - beta ) * fxm
-       ENDDO
-
-       DO i = 1,nmax
-         xxpr(nmax2-i+1) = xxpr(i)
+       Xf(0) = - pi
+
+       DO i =  nmax +1, nmax2
+
+       xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )
+       fa  = tau*  ( dzoom/2.  - xmoy )
+       fb  = xmoy *  ( pi - xmoy )
+
+       IF( 200.* fb .LT. - fa )   THEN
+         fxm = - 1.
+       ELSEIF( 200. * fb .LT. fa ) THEN
+         fxm =   1.
+       ELSE
+         fxm =  TANH ( fa/fb )
+       ENDIF
+
+       IF ( xmoy.EQ. 0. )  fxm =  1.
+       IF ( xmoy.EQ. pi )  fxm = -1.
+       xxpr(i)    = beta + ( grossism - beta ) * fxm
+
+       ENDDO
+
+       DO i = nmax+1, nmax2
+        xxpr(nmax2-i+1) = xxpr(i)
        ENDDO
 
@@ -103,10 +201,4 @@
          Xf(i)   = Xf(i-1) + xxpr(i) * ( xtild(i) - xtild(i-1) )
         ENDDO
-        do i=1,nmax2
-        xf(i)=xf(i)/xf(nmax2)
-        enddo
-
-
-       PRINT *,' XF ',xf(0),xf(nmax),xf(nmax2)
 
 
@@ -117,79 +209,92 @@
 c     .....  xuv = 0.5  si  calcul  aux pts      U        ........
 c
+      WRITE(6,18)
 c
       DO 5000  ik = 1, 4
 
        IF( ik.EQ.1 )        THEN
-         xuv = - 0.25
+         xuv =  -0.25
        ELSE IF ( ik.EQ.2 )  THEN
          xuv =   0.
        ELSE IF ( ik.EQ.3 )  THEN
-         xuv =   0.5
+         xuv =   0.50
        ELSE IF ( ik.EQ.4 )  THEN
          xuv =   0.25
        ENDIF
 
-
-      DO 1500 i = 1, iim
-
-      xlon2 = (  FLOAT(i) + xuv - 0.75) / FLOAT(iim) 
-
       xo1   = 0.
-      xi    = xlon2
-c
-      DO 500 iter = 1,300
-
+
+      ii1=1
+      ii2=iim
+      IF(ik.EQ.1.and.grossism.EQ.1.) THEN
+        ii1 = 2 
+        ii2 = iim+1
+      ENDIF
+      DO 1500 i = ii1, ii2
+
+      xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim) 
+
+      Xfi    = xlon2
+c
       DO 250 it =  nmax2,0,-1
-      IF( xi.GE.xtild(it))  GO TO 350
+      IF( Xfi.GE.Xf(it))  GO TO 350
 250   CONTINUE
 
       it = 0
-      xi = xtild(it)
 
 350   CONTINUE
-       IF(it.EQ.nmax2)  THEN
-        it       = nmax2 -1
-        xf(it+1) = 1.
-       ENDIF
-c  .................................................................
-c  ....  Interpolation entre  xi(it) et xi(it+1)   pour avoir X(xi)  
-c      .....           et   X'(xi)                             .....
-c  .................................................................
-
-       xint   = ( Xf(it+1)-Xf(it) ) / ( xtild(it+1)-xtild(it) )      * 
-     +                    ( xi-xtild(it) )  +  Xf(it)
-      Xprimin = ( Xprimt(it+1)-Xprimt(it) )/ ( xtild(it+1)-xtild(it) ) *
-     +                    ( xi-xtild(it) )  +  Xprimt(it)
-
-       xi = xi - (xint-xlon2)/Xprimin
-
-      IF( ABS(xi-xo1).LE.epsilon) GO TO 550
-      xo1 = xi
-c
+
+c    ......  Calcul de   Xf(xi)    ...... 
+c
+      xi  = xtild(it)
+
+      IF(it.EQ.nmax2)  THEN
+       it       = nmax2 -1
+       Xf(it+1) = pi
+      ENDIF
+c  .....................................................................
+c
+c   Appel de la routine qui calcule les coefficients a0,a1,a2,a3 d'un
+c   polynome de degre 3  qui passe  par les points (Xf(it),xtild(it) )
+c          et (Xf(it+1),xtild(it+1) )
+
+       CALL coefpoly ( Xf(it),Xf(it+1),Xprimt(it),Xprimt(it+1),
+     ,                xtild(it),xtild(it+1),  a0, a1, a2, a3  )
+
+       Xf1     = Xf(it)
+       Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
+
+       DO 500 iter = 1,300
+        xi = xi - ( Xf1 - Xfi )/ Xprimin
+
+        IF( ABS(xi-xo1).LE.epsilon)  GO TO 550
+         xo1      = xi
+         xi2      = xi * xi
+         Xf1      = a0 +  a1 * xi +     a2 * xi2  +     a3 * xi2 * xi
+         Xprimin  =       a1      + 2.* a2 *  xi  + 3.* a3 * xi2
 500   CONTINUE
-      PRINT *,' ***   PAS DE SOLUTION  ****  ',i,xlon2
-        STOP 4
+        WRITE(6,*) ' Pas de solution ***** ',i,xlon2,iter
+          STOP 6
 550   CONTINUE
 
-       xxprim(i)   = depi/( FLOAT(iim) * Xprimin)
-       xvrai(i)    = depi *  (xi - 0.5) + xzoom
-
+       xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )
+       xvrai(i)  =  xi + xzoom
 
 1500   CONTINUE
 
+
+       IF(ik.EQ.1.and.grossism.EQ.1.)  THEN
+         xvrai(1)    = xvrai(iip1)-depi
+         xxprim(1)   = xxprim(iip1)
+       ENDIF
        DO i = 1 , iim
-        xlon  (i)   = xvrai(i)
+        xlon(i)     = xvrai(i)
         xprimm(i)   = xxprim(i)
-cc        xxlon(i) = xlon(i)*180./pi
-       ENDDO
-        
-cc      PRINT *,' XLON avant '
-cc      PRINT 68,(xxlon(i),i=1,iim)
-       
+       ENDDO
        DO i = 1, iim -1
         IF( xvrai(i+1). LT. xvrai(i) )  THEN
-         PRINT *,' PBS.  avec  rlonu(',i+1,' plus petit que rlonu(',i,
-     ,   ')'
-         STOP
+         WRITE(6,*) ' PBS. avec rlonu(',i+1,') plus petit que rlonu(',i,
+     ,  ')'
+        STOP 7
         ENDIF
        ENDDO
@@ -205,12 +310,9 @@
        ENDDO
 
-       PRINT *,' LONGITUDES  min max ',champmin,champmax
-
-      IF(champmin .GE. - pi .AND. champmax.LE. pi )  THEN
+      IF(champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10 )  THEN
                 GO TO 1600
       ELSE
-        PRINT 18
-        PRINT *,'Reorganisation des longitudes pour avoir entre - pi ',
-     ,  ' et  pi '
+       WRITE(6,*) 'Reorganisation des longitudes pour avoir entre - pi',
+     ,  ' et pi '
 c
         IF( xzoom.LE.0.)  THEN
@@ -219,6 +321,6 @@
            IF( xvrai(i).GE. - pi )  GO TO 80
           ENDDO
-            PRINT *, ' PBS. 1 '
-            STOP
+            WRITE(6,*)  ' PBS. 1 !  Xvrai plus petit que  - pi ! '
+            STOP 8
  80       CONTINUE
           is2 = i
@@ -238,12 +340,11 @@
           IF( ik.EQ.1 )  THEN
            DO i = iim,1,-1
-            IF( xvrai(i).LE. pi )  GO TO 90
-           ENDDO
-             PRINT *,' PBS.  2 '
-              STOP
+             IF( xvrai(i).LE. pi ) GO TO 90
+           ENDDO
+             WRITE(6,*) ' PBS.  2 ! Xvrai plus grand  que   pi ! '
+              STOP 9
  90        CONTINUE
             is2 = i
           ENDIF
-cc           PRINT *,' IS2 ',is2
            idif = iim -is2
            DO ii = 1, is2
@@ -270,84 +371,76 @@
          ENDDO
 
-
          IF( ik.EQ.1 )  THEN
-         PRINT *, ' XLON aux pts. V-0.25   apres ( en  deg. ) '
-         PRINT 18
-         PRINT 68,xvrai
-         PRINT *,' XPRIM '
-         PRINT 68, xprimm
-           DO i = 1,iim + 1
+c          WRITE(6,*)  ' XLON aux pts. V-0.25   apres ( en  deg. ) '
+c          WRITE(6,18) 
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM k ',ik
+c          WRITE(6,566)  xprimm
+
+           DO i = 1,iim +1
              rlonm025(i) = xlon( i )
             xprimm025(i) = xprimm(i)
            ENDDO
          ELSE IF( ik.EQ.2 )  THEN
-         PRINT 18
-         PRINT *, ' XLON aux pts. V   apres ( en  deg. ) '
-         PRINT 68,xvrai
-         PRINT *,' XPRIM '
-         PRINT 68, xprimm
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. V   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM k ',ik
+c          WRITE(6,566)  xprimm
+
            DO i = 1,iim + 1
              rlonv(i) = xlon( i )
             xprimv(i) = xprimm(i)
            ENDDO
-         ELSE IF( ik.EQ.3 )  THEN
-         PRINT 18
-         PRINT *, ' XLON aux pts. U   apres ( en  deg. ) '
-         PRINT 68,xvrai
-         PRINT *,' XPRIM '
-         PRINT 68, xprimm
+
+         ELSE IF( ik.EQ.3)   THEN
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. U   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM ik ',ik
+c          WRITE(6,566)  xprimm
+
            DO i = 1,iim + 1
              rlonu(i) = xlon( i )
             xprimu(i) = xprimm(i)
            ENDDO
+
          ELSE IF( ik.EQ.4 )  THEN
-         PRINT 18
-         PRINT *, ' XLON aux pts. V+0.25   apres ( en  deg. ) '
-         PRINT 68,xvrai
-         PRINT *,' XPRIM '
-         PRINT 68, xprimm
+c          WRITE(6,18) 
+c          WRITE(6,*)  ' XLON aux pts. V+0.25   apres ( en  deg. ) '
+c          WRITE(6,68) xvrai
+c          WRITE(6,*) ' XPRIM ik ',ik
+c          WRITE(6,566)  xprimm
+
            DO i = 1,iim + 1
              rlonp025(i) = xlon( i )
             xprimp025(i) = xprimm(i)
            ENDDO
+
          ENDIF
 
 5000    CONTINUE
 c
-c       ...........  fin  de la boucle  do 5000      ............
-
-c
-        DO i = 1, iim + 1
-         dlon1(i) = rlonm025(i) - rlonv(i)
-         dlon2(i) = rlonm025(i) - rlonp025(i)
-         dlon3(i) = rlonm025(i) - rlonu(i)
+       WRITE(6,18)
+c
+c    ...........  fin  de la boucle  do 5000      ............
+
+        DO i = 1, iim
+         xlon(i) = rlonv(i+1) - rlonv(i)
         ENDDO
-
-        DO i = 1, iim + 1
-         rlonm025(i) = rlonm025(i) + dlon1(i)
+        champmin =  1.e12
+        champmax = -1.e12
+        DO i = 1, iim
+         champmin = MIN( champmin, xlon(i) )
+         champmax = MAX( champmax, xlon(i) )
         ENDDO
-
-        DO i = 1, iim + 1
-         rlonv(i)    = rlonm025(i) - dlon1(i)
-         rlonp025(i) = rlonm025(i) - dlon2(i)
-         rlonu(i)    = rlonm025(i) - dlon3(i)
-        ENDDO
-
-        DO i = 1, iim
-         xprimu   (i) = rlonu(i+1) - rlonu(i)
-         xprimv   (i) = rlonv(i+1) - rlonv(i)
-         xprimm025(i) = rlonm025(i+1) - rlonm025(i)
-         xprimp025(i) = rlonp025(i+1) - rlonp025(i)
-        ENDDO
-         xprimu   (iip1) = xprimu   (1)
-         xprimv   (iip1) = xprimv   (1)
-         xprimm025(iip1) = xprimm025(1)
-         xprimp025(iip1) = xprimp025(1)
-
-
-18       FORMAT(/)
-68       FORMAT(1x,7f9.2)
-
-
-         RETURN
-         END
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+18     FORMAT(/)
+24     FORMAT(2x,'Parametres xzoom,gross,tau ,dzoom pour fxhyp ',4f8.3)
+68     FORMAT(1x,7f9.2)
+566    FORMAT(1x,7f9.4)
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fxyhyper.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/fxyhyper.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fxyhyper.F	(revision 497)
@@ -1,4 +1,7 @@
-       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy,deltay  , 
-     ,                      xzoom, grossx, dzoomx,taux,
+c
+c $Header$
+c
+       SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,   
+     ,                       xzoom, grossx, dzoomx,taux  ,
      , rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  , 
      , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)
@@ -19,13 +22,9 @@
 c     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )
 c     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )
-c     c) la raideur       du zoom  :   tau   , ici  =  1.
+c     c) la raideur de la transition du zoom  :   taux et tauy   
 c
-c     N.B :   le produit ( grossissement * extension )  doit etre <  1.
-c    *******
-c     En plus , il y a un autre parametre , moins important mais quand
-c     meme utile , c'est  deltay , deplacement de la zone du zoom en
-c     latitude   :  Si  on deplace  de 10. degres vers le nord  ( deltay
-c      = 10.  dans inigeom ) .
-c
+c  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )
+c ******
+c                  et              grossy * dzoomy <  pi/2  ( radians )
 c
 #include "dimensions.h"
@@ -40,5 +39,5 @@
        REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1),
      , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)
-       REAL deltay
+       REAL*8  dxmin, dxmax , dymin, dymax
 
 c   ....   var. locales   .....
@@ -47,30 +46,30 @@
 c
 
-       CALL fyhyp ( yzoom, grossy, dzoomy,tauy, deltay , 
-     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 )
+       CALL fyhyp ( yzoom, grossy, dzoomy,tauy  , 
+     ,  rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  dymin,dymax                                               )
+
+       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
+     , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )
 
 
-       CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv,
-     , xprimv,rlonu,xprimu,rlonp025,xprimp025 )
-
-
-        DO i = 1, iim
+        DO i = 1, iip1
           IF(rlonp025(i).LT.rlonv(i))  THEN
-           PRINT *,' Attention !  rlonp025 < rlonv',i
+           WRITE(6,*) ' Attention !  rlonp025 < rlonv',i
             STOP
           ENDIF
 
           IF(rlonv(i).LT.rlonm025(i))  THEN 
-           PRINT *,' Attention !  rlonm025 > rlonv',i
+           WRITE(6,*) ' Attention !  rlonm025 > rlonv',i
             STOP
           ENDIF
 
           IF(rlonp025(i).GT.rlonu(i))  THEN
-           PRINT *,' Attention !  rlonp025 > rlonu',i
+           WRITE(6,*) ' Attention !  rlonp025 > rlonu',i
             STOP
           ENDIF
         ENDDO
 
-        PRINT *,'  *** TEST DE COHERENCE  OK    POUR   FX **** '
+        WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FX **** '
 
 c
@@ -78,30 +77,30 @@
 c
        IF(rlatu1(j).LE.rlatu2(j))   THEN
-         PRINT *,' Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
+         WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j
          STOP 13
        ENDIF
 c
        IF(rlatu2(j).LE.rlatu(j+1))  THEN
-        PRINT *,' Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
+        WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j
         STOP 14
        ENDIF
 c
        IF(rlatu(j).LE.rlatu1(j))    THEN
-        PRINT *,' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
+        WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j
         STOP 15
        ENDIF
 c
        IF(rlatv(j).LE.rlatu2(j))    THEN
-        PRINT *,' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
+        WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j
         STOP 16
        ENDIF
 c
        IF(rlatv(j).ge.rlatu1(j))    THEN
-        PRINT *,' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
+        WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j
         STOP 17
        ENDIF
 c
        IF(rlatv(j).ge.rlatu(j))     THEN
-        PRINT *,'Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
+        WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j
         STOP 18
        ENDIF
@@ -109,7 +108,28 @@
        ENDDO
 c
-       PRINT *,'  *** TEST DE COHERENCE  OK    POUR   FY **** '
-
+       WRITE(6,*) '  *** TEST DE COHERENCE  OK    POUR   FY **** '
 c
+        WRITE(6,18)
+        WRITE(6,*) '  Latitudes  '
+        WRITE(6,*) ' *********** '
+        WRITE(6,18)
+        WRITE(6,3)  dymin, dymax
+        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
+     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
+c
+        WRITE(6,18)
+        WRITE(6,*) '  Longitudes  '
+        WRITE(6,*) ' ************ '
+        WRITE(6,18)
+        WRITE(6,3)  dxmin, dxmax
+        WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par
+     ,ametres  grossism , tau , dzoom pour Y et repasser ! '
+        WRITE(6,18)
+c
+3      Format(1x, ' Au centre du zoom , la longueur de la maille est',
+     ,  ' d environ ',f8.2 ,' degres  ',
+     , ' alors que la maille en dehors de la zone du zoom est d environ
+     , ', f8.2,' degres ' )
+18      FORMAT(/)
 
        RETURN
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fyhyp.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/fyhyp.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/fyhyp.F	(revision 497)
@@ -1,5 +1,10 @@
-       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzoom,tau,deltay ,  
-     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ) 
-
+c
+c $Header$
+c
+       SUBROUTINE fyhyp ( yzoomdeg, grossism, dzoom,tau  ,  
+     ,  rrlatu,yyprimu,rrlatv,yyprimv,rlatu2,yprimu2,rlatu1,yprimu1 ,
+     ,  champmin,champmax                                            ) 
+
+cc    ...  Version du 01/04/2001 ....
 
        IMPLICIT NONE
@@ -13,14 +18,10 @@
 c
 c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)
-c     dzoom  etant  la distance totale de la zone du zoom
-c     tau  la transition ,   normalement  = 1  .
-
-c  N.B :  on doit avoir :  grossism * dzoom  <   1 .
-c         **************
-c
-c    Pour Indoex , on a pris :
-c         *******
-c    grossism = 2.5 , dzoom = 7/24  en x et  y  , pour iim = 128 et jjm=64
-c    yzoomdeg = 0.  , tau = 1.  et delaty = 10.
+c     dzoom  etant  la distance totale de la zone du zoom ( en radians )
+c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom   
+c
+c
+c N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en lati.
+c      ********************************************************************
 c
 c
@@ -29,10 +30,11 @@
 
        INTEGER      nmax , nmax2
-       PARAMETER (  nmax = 50000, nmax2 = 2*nmax )
+       PARAMETER (  nmax = 30000, nmax2 = 2*nmax )
 c
 c
 c     .......  arguments  d'entree    .......
 c
-       REAL yzoomdeg, grossism,dzoom,tau , deltay
+       REAL yzoomdeg, grossism,dzoom,tau 
+c         ( rentres  par  run.def )
 
 c     .......  arguments  de sortie   .......
@@ -42,17 +44,18 @@
 
 c
-c    ..... Champs  locaux    .....
+c     .....     champs  locaux    .....
 c
      
-       REAl ylat(jjp1), yprim(jjp1)
-       REAL yuv
-       REAL ytild(0:nmax2)
-       REAL fhyp(0:nmax),ffdx(0:nmax),beta,Ytprim(0:nmax2)
-       SAVE Ytprim, ytild,Yf
-       REAL Yf(0:nmax2),yypr(0:nmax2)
-       REAL yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
-       REAL pi,depi,pis2,epsilon,yzoom
-       REAL yo1,yi,ylon2,fxm,ymoy,yint,Yprimin
-       REAL ypn,deply,y00
+       REAL*8 ylat(jjp1), yprim(jjp1)
+       REAL*8 yuv
+       REAL*8 yt(0:nmax2)
+       REAL*8 fhyp(0:nmax2),beta,Ytprim(0:nmax2),fxm(0:nmax2)
+       SAVE Ytprim, yt,Yf
+       REAL*8 Yf(0:nmax2),yypr(0:nmax2)
+       REAL*8 yvrai(jjp1), yprimm(jjp1),ylatt(jjp1)
+       REAL*8 pi,depi,pis2,epsilon,y0,pisjm
+       REAL*8 yo1,yi,ylon2,ymoy,Yprimin,champmin,champmax
+       REAL*8 yfi,Yf1,ffdy
+       REAL*8 ypn,deply,y00
        SAVE y00, deply
 
@@ -60,71 +63,122 @@
        INTEGER jpn,jjpn
        SAVE jpn
-
+       REAL*8 a0,a1,a2,a3,yi2,heavyy0,heavyy0m
+       REAL*8 fa(0:nmax2),fb(0:nmax2)
+       REAL y0min,y0max
+
+       REAL*8     heavyside
+       EXTERNAL   heavyside
 
        pi       = 2. * ASIN(1.)
        depi     = 2. * pi
        pis2     = pi/2.
-       epsilon  = 1.e-6
-       yzoom    = yzoomdeg * pi/180. 
-
-
+       pisjm    = pi/ FLOAT(jjm)
+       epsilon  = 1.e-3
+       y0       =  yzoomdeg * pi/180. 
+
+       IF( dzoom.LT.1.)  THEN
+         dzoom = dzoom * pi
+       ELSEIF( dzoom.LT. 12. ) THEN
+         WRITE(6,*) ' Le param. dzoomy pour fyhyp est trop petit ! L aug
+     ,menter et relancer ! '
+         STOP 1
+       ELSE
+         dzoom = dzoom * pi/180.
+       ENDIF
+
+       WRITE(6,18)
+       WRITE(6,*) ' yzoom( rad.),grossism,tau,dzoom (radians)'
+       WRITE(6,24) y0,grossism,tau,dzoom
 
        DO i = 0, nmax2 
-        ytild(i) = FLOAT(i) /nmax2
-       IF( ytild(i).EQ.0.5 )  ytild(i) = ytild(i) + 1.e-6
-       ENDDO
-
-       DO i = 1, nmax
-        fhyp(i) = TANH ( ( ytild(i) - 0.5*(1.- dzoom) )          /
-     ,                 ( tau * ytild(i) * ( 0.5 -ytild(i))) )
-       ENDDO
-
-       fhyp(   0  ) = - 1.
-       fhyp( nmax ) =   1.
+        yt(i) = - pis2  + FLOAT(i)* pi /nmax2
+       ENDDO
+
+       heavyy0m = heavyside( -y0 )
+       heavyy0  = heavyside(  y0 )
+       y0min    = 2.*y0*heavyy0m - pis2
+       y0max    = 2.*y0*heavyy0  + pis2
+
+       fa = 999.999
+       fb = 999.999
+       
+       DO i = 0, nmax2 
+        IF( yt(i).LT.y0 )  THEN
+         fa (i) = tau*  (yt(i)-y0+dzoom/2. )
+         fb(i) =   (yt(i)-2.*y0*heavyy0m +pis2) * ( y0 - yt(i) )
+        ELSEIF ( yt(i).GT.y0 )  THEN
+         fa(i) =   tau *(y0-yt(i)+dzoom/2. )
+         fb(i) = (2.*y0*heavyy0 -yt(i)+pis2) * ( yt(i) - y0 ) 
+       ENDIF
+        
+       IF( 200.* fb(i) .LT. - fa(i) )   THEN
+         fhyp ( i) = - 1.
+       ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fhyp ( i) =   1.
+       ELSE  
+         fhyp(i) =  TANH ( fa(i)/fb(i) )
+       ENDIF
+
+       IF( yt(i).EQ.y0 )  fhyp(i) = 1.
+       IF(yt(i).EQ. y0min. OR.yt(i).EQ. y0max ) fhyp(i) = -1.
+
+       ENDDO
 
 cc  ....  Calcul  de  beta  ....
 c
-       ffdx( 0 ) = 0.
-
-       DO i = 1, nmax
-        ymoy    = 0.5 * ( ytild(i-1) + ytild( i ) )
-        fxm     = TANH ( ( ymoy - 0.5 * ( 1. - dzoom ) )    /
-     ,                 ( tau * ymoy * ( 0.5 -ymoy)) )
-        ffdx(i) = ffdx(i-1) + fxm * ( ytild(i) - ytild(i-1) )
-       ENDDO
-
-        beta  = ( grossism * ffdx(nmax) - 0.5 ) / ( ffdx(nmax) - 0.5 )
+       ffdy   = 0.
+
+       DO i = 1, nmax2
+        ymoy    = 0.5 * ( yt(i-1) + yt( i ) )
+        IF( ymoy.LT.y0 )  THEN
+         fa(i)= tau * ( ymoy-y0+dzoom/2.) 
+         fb(i) = (ymoy-2.*y0*heavyy0m +pis2) * ( y0 - ymoy )
+        ELSEIF ( ymoy.GT.y0 )  THEN
+         fa(i)= tau * ( y0-ymoy+dzoom/2. ) 
+         fb(i) = (2.*y0*heavyy0 -ymoy+pis2) * ( ymoy - y0 )
+        ENDIF
+
+        IF( 200.* fb(i) .LT. - fa(i) )    THEN
+         fxm ( i) = - 1.
+        ELSEIF( 200. * fb(i) .LT. fa(i) ) THEN
+         fxm ( i) =   1.
+        ELSE
+         fxm(i) =  TANH ( fa(i)/fb(i) )
+        ENDIF
+         IF( ymoy.EQ.y0 )  fxm(i) = 1.
+         IF (ymoy.EQ. y0min. OR.yt(i).EQ. y0max ) fxm(i) = -1.
+         ffdy = ffdy + fxm(i) * ( yt(i) - yt(i-1) )
+
+        ENDDO
+
+        beta  = ( grossism * ffdy - pi ) / ( ffdy - pi )
+
+       IF( 2.*beta - grossism.LE. 0.)  THEN
+
+        WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou
+     ,tine fyhyp est mauvaise ! '
+        WRITE(6,*)'Modifier les valeurs de  grossismy ,tauy ou dzoomy',
+     , ' et relancer ! ***  '
+        CALL ABORT
+
+       ENDIF
 c
 c   .....  calcul  de  Ytprim   .....
 c
        
-       DO i = 0, nmax
+       DO i = 0, nmax2
         Ytprim(i) = beta  + ( grossism - beta ) * fhyp(i)
        ENDDO
-c   
-       DO i = 0, nmax
-        Ytprim( nmax2 - i ) = Ytprim( i )
-       ENDDO
-c
 
 c   .....  Calcul  de  Yf     ........
 
-        Yf(0) = 0.
-       DO i = 1, nmax
-        ymoy    = 0.5 * ( ytild(i-1) + ytild( i ) )
-        fxm     = TANH ( ( ymoy - 0.5 * ( 1. - dzoom ) )    /
-     ,                 ( tau * ymoy * ( 0.5 -ymoy)) )
-        yypr(i)    = beta + ( grossism - beta ) * fxm
-       ENDDO
-
-       DO i = 1,nmax
-         yypr(nmax2-i+1) = yypr(i)
-       ENDDO
-
-        DO i=1,nmax2
-         Yf(i)   = Yf(i-1) + yypr(i) * ( ytild(i) - ytild(i-1) )
-        ENDDO
-c
-c
+       Yf(0) = - pis2
+       DO i = 1, nmax2
+        yypr(i)    = beta + ( grossism - beta ) * fxm(i)
+       ENDDO
+
+       DO i=1,nmax2
+        Yf(i)   = Yf(i-1) + yypr(i) * ( yt(i) - yt(i-1) )
+       ENDDO
 
 c    ****************************************************************
@@ -133,4 +187,5 @@
 c   .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....
 c
+      WRITE(6,18)
 c
       DO 5000  ik = 1,4
@@ -149,28 +204,21 @@
          jlat = jjm 
        ENDIF
-        
-c
+c
+       yo1   = 0.
        DO 1500 j =  1,jlat
-
-        ylon2 =  ( FLOAT(j)  + yuv  -1.) / FLOAT(jjm) 
-
         yo1   = 0.
-        yi    = ylon2
-
-c
-       DO 500 iter = 1,300
-
+        ylon2 =  - pis2 + pisjm * ( FLOAT(j)  + yuv  -1.)  
+        yfi    = ylon2
+c
        DO 250 it =  nmax2,0,-1
-        IF( yi.GE.ytild(it))  GO TO 350
+        IF( yfi.GE.Yf(it))  GO TO 350
 250    CONTINUE
-
        it = 0
-       yi = ytild(it)
-
 350    CONTINUE
 
+       yi = yt(it)
        IF(it.EQ.nmax2)  THEN
         it       = nmax2 -1
-        Yf(it+1) = 1.
+        Yf(it+1) = pis2
        ENDIF
 c  .................................................................
@@ -179,41 +227,42 @@
 c  .................................................................
 
-       yint   = ( Yf(it+1)-Yf(it) ) / ( ytild(it+1)-ytild(it) )      * 
-     +                    ( yi-ytild(it) )  +  Yf(it)
-      Yprimin = ( Ytprim(it+1)-Ytprim(it) )/ ( ytild(it+1)-ytild(it) ) *
-     +                    ( yi-ytild(it) )  +  Ytprim(it)
-       yi = yi - (yint-ylon2)/Yprimin
-
-      IF( ABS(yi-yo1).LE.epsilon) GO TO 550
-      yo1 = yi
-c
+       CALL coefpoly ( Yf(it),Yf(it+1),Ytprim(it), Ytprim(it+1),   
+     ,                  yt(it),yt(it+1) ,   a0,a1,a2,a3   )      
+
+       Yf1     = Yf(it)
+       Yprimin = a1 + 2.* a2 * yi + 3.*a3 * yi *yi
+
+       DO 500 iter = 1,300
+         yi = yi - ( Yf1 - yfi )/ Yprimin
+
+        IF( ABS(yi-yo1).LE.epsilon)  GO TO 550
+         yo1      = yi
+         yi2      = yi * yi
+         Yf1      = a0 +  a1 * yi +     a2 * yi2  +     a3 * yi2 * yi
+         Yprimin  =       a1      + 2.* a2 *  yi  + 3.* a3 * yi2
 500   CONTINUE
-      PRINT *,' ***   PAS DE SOLUTION  ****  ',j,ylon2,iter
-        STOP 4
+        WRITE(6,*) ' Pas de solution ***** ',j,ylon2,iter
+         STOP 2
 550   CONTINUE
-
-       yprim(j)    = pi /( FLOAT(jjm) *  Yprimin)
-       yvrai(j)    = pi *  (yi - 0.5) + yzoom
+c
+       Yprimin   = a1  + 2.* a2 *  yi   + 3.* a3 * yi* yi
+       yprim(j)  = pi / ( jjm * Yprimin )
+       yvrai(j)  = yi 
 
 1500    CONTINUE
-
-cc          print *,' LAT avant reorgan '
-cc         print 68,(yyvrai(j),j=1,jlat)
 
        DO j = 1, jlat -1
         IF( yvrai(j+1). LT. yvrai(j) )  THEN
-         PRINT *,' PBS.  avec  rlat(',j+1,' plus petit que rlat(',j,
-     ,   ')'
-         STOP
-        ENDIF
-       ENDDO
-
-        PRINT 18
-        PRINT *,'Reorganisation des latitudes pour avoir entre - pi/2 ',
-     ,  ' et  pi/2 '
-c
-           
+         WRITE(6,*) ' PBS. avec  rlat(',j+1,') plus petit que rlat(',j,
+     ,  ')'
+         STOP 3
+        ENDIF
+       ENDDO
+
+       WRITE(6,*) 'Reorganisation des latitudes pour avoir entre - pi/2'
+     , ,' et  pi/2 '
+c
         IF( ik.EQ.1 )   THEN
-           ypn = pis2 - deltay * pi/180.
+           ypn = pis2 
           DO j = jlat,1,-1
            IF( yvrai(j).LE. ypn ) GO TO 1502
@@ -239,11 +288,7 @@
          ENDDO
 
-
-
 c      ***********   Fin de la reorganisation     *************
 c
  1600   CONTINUE
-
-
 
        DO j = 1, jlat
@@ -256,33 +301,35 @@
         ENDDO
 
-
         IF( ik.EQ.1 )  THEN
-        PRINT 18
-        PRINT *, ' YLAT  en U   apres ( en  deg. ) '
-        PRINT 68,(yvrai(j),j=1,jlat)
-        PRINT *,' YPRIM '
-        PRINT 68,( yprim(j),j=1,jlat)
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
           DO j = 1, jlat
             rrlatu(j) =  ylat( j )
            yyprimu(j) = yprim( j )
           ENDDO
-c
+
         ELSE IF ( ik.EQ. 2 )  THEN
-        PRINT 18
-        PRINT *, ' YLAT   en V  apres ( en  deg. ) '
-        PRINT 68,(yvrai(j),j=1,jlat)
-        PRINT *,' YPRIM '
-        PRINT 68,( yprim(j),j=1,jlat)
+c         WRITE(6,18) 
+c         WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*)' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
           DO j = 1, jlat
             rrlatv(j) =  ylat( j )
            yyprimv(j) = yprim( j )
           ENDDO
-c
+
         ELSE IF ( ik.EQ. 3 )  THEN
-        PRINT 18
-        PRINT *, ' YLAT  en U + 0.75  apres ( en  deg. ) '
-        PRINT 68,(yvrai(j),j=1,jlat)
-        PRINT *,' YPRIM '
-        PRINT 68,( yprim(j),j=1,jlat)
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '
+c         WRITE(6,68) (yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,445) ( yprim(j),j=1,jlat)
+
           DO j = 1, jlat
             rlatu2(j) =  ylat( j )
@@ -291,19 +338,36 @@
 
         ELSE IF ( ik.EQ. 4 )  THEN
-        PRINT 18
-        PRINT *, ' YLAT en U + 0.25  apres ( en  deg. ) '
-        PRINT 68,(yvrai(j),j=1,jlat)
-        PRINT *,' YPRIM '
-        PRINT 68,( yprim(j),j=1,jlat)
+c         WRITE(6,18) 
+c         WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '
+c         WRITE(6,68)(yvrai(j),j=1,jlat)
+cc         WRITE(6,*) ' YPRIM '
+cc         WRITE(6,68) ( yprim(j),j=1,jlat)
+
           DO j = 1, jlat
             rlatu1(j) =  ylat( j )
            yprimu1(j) = yprim( j )
           ENDDO
+
         ENDIF
 
 5000   CONTINUE
 c
+        WRITE(6,18)
+c
 c  .....     fin de la boucle  do 5000 .....
 
+        DO j = 1, jjm
+         ylat(j) = rrlatu(j) - rrlatu(j+1)
+        ENDDO
+        champmin =  1.e12
+        champmax = -1.e12
+        DO j = 1, jjm
+         champmin = MIN( champmin, ylat(j) )
+         champmax = MAX( champmax, ylat(j) )
+        ENDDO
+         champmin = champmin * 180./pi
+         champmax = champmax * 180./pi
+
+24     FORMAT(2x,'Parametres yzoom,gross,tau ,dzoom pour fyhyp ',4f8.3)
 18      FORMAT(/)
 68      FORMAT(1x,7f9.2)
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/gcm.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/gcm.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/gcm.F	(revision 497)
@@ -1,4 +1,6 @@
 
       PROGRAM gcm
+
+      USE IOIPSL
 
       IMPLICIT NONE
@@ -20,11 +22,13 @@
 c
 c=======================================================================
-
-c   ...  Dans inigeom , nouveaux calculs pour les elongations  cu , cv 
-c        et possibilite d'appeler une fonction f(y)  a derivee tangente 
-c        hyperbolique a la  place de la fonction a derivee sinusoidale.         
-
-c   ...  Possibilite de choisir le shema de Van-leer pour l'advection de
-c         q  , en faisant iadv = 3  dans   traceur  (29/04/97) .
+c
+c  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
+c      et possibilite d'appeler une fonction f(y)  a derivee tangente
+c      hyperbolique a la  place de la fonction a derivee sinusoidale.
+
+c  ... Possibilite de choisir le shema de Van-leer pour l'advection de
+c        q  , en faisant iadv = 3  dans   traceur  (29/04/97) .
+c
+c      Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
 c
 c-----------------------------------------------------------------------
@@ -115,4 +119,5 @@
 
 
+      INTEGER fluxid, fluxvid,fluxdid
       integer histid, histvid, histaveid
       real time_step, t_wrt, t_ops
@@ -121,4 +126,17 @@
       LOGICAL first
       REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
+c+jld variables test conservation energie
+      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
+C     Tendance de la temp. potentiel d (theta)/ d t due a la 
+C     tansformation d'energie cinetique en energie thermique
+C     cree par la dissipation
+      REAL dhecdt(ip1jmp1,llm)
+      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
+      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
+      CHARACTER*15 ztit
+      INTEGER   ip_ebil_dyn  ! PRINT level for energy conserv. diag.
+      SAVE      ip_ebil_dyn
+      DATA      ip_ebil_dyn/0/
+c-jld 
 
       LOGICAL offline  ! Controle du stockage ds "fluxmass"
@@ -129,8 +147,17 @@
       character*80 abort_message
 
+C Calendrier
+      LOGICAL true_calendar
+      PARAMETER (true_calendar = .false.)
+C Run nudge
+      LOGICAL ok_nudge
+      PARAMETER (ok_nudge = .false.)
+c
+
 c-----------------------------------------------------------------------
 c   Initialisations:
 c   ----------------
 
+      abort_message = 'last timestep reached'
       modname = 'gcm'
       descript = 'Run GCM LMDZ'
@@ -138,4 +165,10 @@
       dynhist_file = 'dyn_hist.nc'
       dynhistave_file = 'dyn_hist_ave.nc'
+
+      if (true_calendar) then
+        call ioconf_calendar('gregorian')
+      else
+        call ioconf_calendar('360d')
+      endif
 c-----------------------------------------------------------------------
 c
@@ -146,4 +179,6 @@
 c     iadv = 2    shema   amont
 c     iadv = 3    shema  Van-leer
+c     iadv = 4    schema  Van-leer + humidite specifique
+c                        Modif F.Codron
 c 
 c     dans le tableau q(ij,l,iq) , iq = 1  pour l'eau vapeur
@@ -151,11 +186,27 @@
 c         et eventuellement      , iq = 3, nqmx pour les autres traceurs
 c
-c     iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
-c
       DO iq = 1, nqmx
        iadv( iq ) = 3
       ENDDO
 c
-      DO  iq = 1, nqmx
+c     iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
+      iadv( 1 ) = 4
+c
+       IF( iadv(1).EQ.1 ) PRINT *,' Choix du shema humidite specifique'
+     * ,' pour la vapeur d''eau'
+       IF( iadv(1).EQ.2 ) PRINT *,' Choix du shema  amont',' pour la'
+     * ,' vapeur d''eau '
+       IF( iadv(1).EQ.3 ) PRINT *,' Choix du shema  Van-Leer ',' pour'
+     * ,'la vapeur d''eau'
+       IF( iadv(1).EQ.4 ) PRINT *,' Choix du shema  Van-Leer + humidite'
+     * ,' specifique pour la vapeur d''eau'
+c
+       IF( iadv(1).LE.0.OR.iadv(1).GT.4 )   THEN
+        PRINT *,' Erreur dans le choix de iadv (1).Corriger et repasser
+     * ,  car  iadv(1) = ', iadv(1)
+         CALL ABORT
+       ENDIF
+
+      DO  iq = 2, nqmx
        IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique'
      * ,' pour le traceur no ', iq
@@ -164,8 +215,16 @@
        IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema  Van-Leer ',' pour'
      * ,'le traceur no ', iq
-       IF( iadv(iq).LE.0.OR.iadv(iq).GT.3 )   THEN
+
+       IF( iadv(iq).EQ.4 )  THEN
+         PRINT *,' Le shema  Van-Leer + humidite specifique ',
+     * ' est  uniquement pour la vapeur d eau .'
+         PRINT *,' Corriger iadv( ',iq, ')  et repasser ! '
+         CALL ABORT
+       ENDIF
+
+       IF( iadv(iq).LE.0.OR.iadv(iq).GT.4 )   THEN
        PRINT *,' Erreur dans le  choix de  iadv . Corriger et repasser
      * . '
-         STOP 
+         CALL ABORT 
        ENDIF
       ENDDO
@@ -174,5 +233,5 @@
       numvanle = nqmx + 1
       DO  iq = 1, nqmx
-        IF( iadv(iq).EQ.3.AND.first ) THEN
+        IF((iadv(iq).EQ.3.OR.iadv(iq).EQ.4).AND.first ) THEN
           numvanle = iq
           first    = .FALSE.
@@ -181,10 +240,10 @@
 c
       DO  iq = 1, nqmx
-        IF( iadv(iq).NE.3.AND.iq.GT.numvanle )   THEN
+      IF( (iadv(iq).NE.3.AND.iadv(iq).NE.4).AND.iq.GT.numvanle )  THEN
           PRINT *,' Il y a discontinuite dans le choix du shema de ',
      *    'Van-leer pour les traceurs . Corriger et repasser . '
-           STOP
-        ENDIF
-        IF( iadv(iq).LT.1.OR.iadv(iq).GT.3 )    THEN
+           CALL ABORT
+      ENDIF
+        IF( iadv(iq).LT.1.OR.iadv(iq).GT.4 )    THEN
           PRINT *,' Le choix de  iadv  est errone pour le traceur ',
      *    iq
@@ -199,5 +258,6 @@
 
 c     OPEN( 99,file ='run.def',status='old',form='formatted')
-      CALL defrun_new( 99, .TRUE. , clesphy0 )
+c      CALL defrun_new( 99, .TRUE. , clesphy0 )
+      CALL conf_gcm( 99, .TRUE. , clesphy0 )
 c     CLOSE(99)
 
@@ -214,4 +274,25 @@
          PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
         ENDIF
+C
+C on remet le calendrier à zero
+c
+      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
+        write(*,*)' Attention les dates initiales lues dans le fichier'
+        write(*,*)' restart ne correspondent pas a celles lues dans '
+        write(*,*)' gcm.def'
+        if (raz_date .ne. 1) then
+          write(*,*)' On garde les dates du fichier restart'
+        else
+          annee_ref = anneeref
+          day_ref = dayref
+          day_ini = dayref
+          itau_dyn = 0
+          itau_phy = 0
+          time_0 = 0.
+          write(*,*)' On reinitialise a la date lue dans gcm.def'
+        endif
+      ELSE
+        raz_date = 0
+      endif
 
 c  nombre d'etats dans les fichiers demarrage et histoire
@@ -229,4 +310,10 @@
       CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
      *                tetagdiv, tetagrot , tetatemp              )
+c+jld
+C     initialisation constantes thermo utilisees dans diagedyn
+      IF (ip_ebil_dyn.ge.1 ) THEN
+        CALL suphec
+      ENDIF 
+c-jld
 c
 
@@ -254,5 +341,5 @@
       PRINT 300, itau,itaufin,day_ini,day_end
 
-      CALL dynredem0("restart.nc",day_end,anne_ini,phis,nqmx)
+      CALL dynredem0("restart.nc", day_end, phis, nqmx)
 
       ecripar = .TRUE.
@@ -261,10 +348,10 @@
       t_ops = iecri * daysec
       t_wrt = iecri * daysec
-      CALL inithist(dynhist_file,day_ini,anne_ini,time_step,
-     .              t_ops, t_wrt, nqmx, histid, histvid)
+C      CALL inithist(dynhist_file,day_ref,annee_ref,time_step,
+c     .              t_ops, t_wrt, nqmx, histid, histvid)
 
       t_ops = iperiod * time_step
       t_wrt = periodav * daysec
-      CALL initdynav(dynhistave_file,day_ini,anne_ini,time_step,
+      CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
      .              t_ops, t_wrt, nqmx, histaveid)
 
@@ -281,10 +368,16 @@
 c   ----------------------------------
 
+
    1  CONTINUE
-c     call nudge(itau,ucov,vcov,teta,masse,ps)
+
+
+
+      if (ok_nudge) then
+        call nudge(itau,ucov,vcov,teta,masse,ps)
+      endif
 c
 c     IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
         CALL  test_period ( ucov,vcov,teta,q,p,phis )
-        PRINT *,' ----   Test_period apres continue   OK ! -----', itau
+c        PRINT *,' ----   Test_period apres continue   OK ! -----', itau
 c     ENDIF 
 c
@@ -358,11 +451,18 @@
          ELSE IF( iq.EQ. nqmx )   THEN
 c
-            iapp_tracvl = 5
+c           iapp_tracvl = 5
+            iapp_tracvl = iperiod
+            print*,'***WARNING***: iapp_tracvl = iperiod'
 c
 cccc     iapp_tracvl est la frequence en pas du groupement des flux
 cccc      de masse pour  Van-Leer dans la routine  tracvl  .
 c
-            CALL vanleer(numvanle,iapp_tracvl,nqmx,q,pbaru,pbarv,
-     *                             p,  masse, dq                  )
+c            CALL vanleer(numvanle,iapp_tracvl,nqmx,q,pbaru,pbarv,
+            CALL vanleer(numvanle,iapp_tracvl,2,q,pbaru,pbarv,
+     *                      p, masse, dq,  iadv(1), teta, pk     )
+c
+            print*,'***WARNING***: Appel vanleer avec 2 traceurs'
+            print*,'               et non nqmx'
+c                   ...  Modif  F.Codron  ....
 c
          ENDIF
@@ -372,5 +472,9 @@
          IF (offline) THEN
 Cmaf stokage du flux de masse pour traceurs OFF-LINE
-           CALL fluxstoke(pbaru,pbarv,masse,teta,phi,phis)
+
+            CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
+     .   time_step, itau)
+
+
          ENDIF
 c
@@ -386,4 +490,5 @@
      $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
      $              finvmaold                                    )
+
 
 c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
@@ -418,4 +523,15 @@
            ENDIF
 c
+
+c rajout debug
+c       lafin = .true.
+c+jld
+      IF (ip_ebil_dyn.ge.1 ) THEN 
+          ztit='bil dyn'
+          CALL diagedyn(ztit,2,1,1,dtphys
+     e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2),aire
+     s  , d_h_vcol , d_qt, d_qw, d_ql, d_ec)
+      ENDIF 
+c-jld
         CALL calfis( nqmx, lafin ,rdayvrai,rday_ecri,time  ,
      $                 ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
@@ -428,4 +544,12 @@
      $                 dufi, dvfi, dhfi , dqfi ,dpfi  )
 c
+c+jld
+      IF (ip_ebil_dyn.ge.1 ) THEN 
+          ztit='bil phys'
+          CALL diagedyn(ztit,2,1,1,dtphys
+     e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2),aire
+     s  , d_h_vcol , d_qt, d_qw, d_ql, d_ec)
+      ENDIF 
+c-jld
        ENDIF
 
@@ -440,4 +564,14 @@
 
       IF(apdiss) THEN
+c+jld
+      IF (ip_ebil_dyn.ge.2 ) THEN 
+          ztit='avant dissip'
+          CALL diagedyn(ztit,2,2,2,dtvr
+     e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2),aire
+     s  , d_h_vcol , d_qt, d_qw, d_ql, d_ec)
+      ENDIF 
+        CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
+        CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin0  )
+c-jld
 
          CALL dissip(vcov,ucov,teta,p,dvdis,dudis,dhdis)
@@ -445,11 +579,31 @@
          CALL addit( ijp1llm,ucov ,dudis,ucov )
          CALL addit( ijmllm ,vcov ,dvdis,vcov )
+c+jld
+        CALL covcont  ( llm    , ucov    , vcov , ucont, vcont        )
+        CALL enercin ( vcov   , ucov  , vcont     , ucont  , ecin  )
+C
+C       On rajoute la tendance due a la transform. Ec -> E therm. cree
+C       lors de la dissipation
+        DO l  =  1, llm
+          DO    ij     = 1, ip1jmp1
+            dhecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
+            dhdis(ij,l) = dhdis(ij,l) + dhecdt(ij,l)
+          ENDDO
+        ENDDO
+c-jld
          CALL addit( ijp1llm,teta ,dhdis,teta )
-
+c+jld
+c
+         IF (ip_ebil_dyn.ge.2 ) THEN 
+             ztit='apres dissip'
+             CALL diagedyn(ztit,2,2,2,dtdiss
+     e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2),aire
+     s  , d_h_vcol , d_qt, d_qw, d_ql, d_ec)
+         ENDIF 
+c-jld
 
 c    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
 c   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
 c
-      IF( alphax.NE. 0. ) THEN
 
         DO l  =  1, llm
@@ -467,7 +621,24 @@
         ENDDO
 
-      ENDIF
+        DO ij =  1,iim
+          tppn(ij)  = aire(  ij    ) * ps (  ij    )
+          tpps(ij)  = aire(ij+ip1jm) * ps (ij+ip1jm)
+        ENDDO
+          tpn  = SSUM(iim,tppn,1)/apoln
+          tps  = SSUM(iim,tpps,1)/apols
+
+        DO ij = 1, iip1
+          ps(  ij    ) = tpn
+          ps(ij+ip1jm) = tps
+        ENDDO
+
 
       END IF
+
+c ajout debug
+c              IF( lafin ) then  
+c                abort_message = 'Simulation finished'
+c                call abort_gcm(modname,abort_message,0)
+c              ENDIF
         
 c   ********************************************************************
@@ -496,4 +667,6 @@
 
             IF( itau. EQ. itaufinp1 ) then  
+
+
               abort_message = 'Simulation finished'
               call abort_gcm(modname,abort_message,0)
@@ -511,4 +684,8 @@
                CALL writedynav(histaveid, nqmx, itau,vcov ,
      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
+cccIM cf. FH
+               call bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
+     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
+
             ENDIF
 
@@ -521,6 +698,6 @@
                nbetat = nbetatdem
        CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi        )
-       CALL writehist( histid, histvid, nqmx, itau,vcov , 
-     ,                          ucov,teta,phi,q,masse,ps,phis)
+c       CALL writehist( histid, histvid, nqmx, itau,vcov , 
+c     ,                          ucov,teta,phi,q,masse,ps,phis)
 
 
@@ -602,4 +779,7 @@
                CALL writedynav(histaveid, nqmx, itau,vcov ,
      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
+cccIM cf. FH
+               call bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
+     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
 
             ENDIF
@@ -608,6 +788,6 @@
                   nbetat = nbetatdem
        CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi       )
-       CALL writehist( histid, histvid, nqmx, itau,vcov , 
-     ,                          ucov,teta,phi,q,masse,ps,phis)
+c       CALL writehist( histid, histvid, nqmx, itau,vcov , 
+c     ,                          ucov,teta,phi,q,masse,ps,phis)
                ENDIF
 
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/gcmtest.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/gcmtest.F	(revision 3)
+++ 	(revision )
@@ -1,656 +1,0 @@
-
-      PROGRAM gcm
-
-      USE IOIPSL
-
-      IMPLICIT NONE
-
-c      ......   Version  du 10/01/98    ..........
-
-c             avec  coordonnees  verticales hybrides 
-c   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
-c   -------
-c
-c   Objet:
-c   ------
-c
-c   GCM LMD nouvelle grille
-c
-c=======================================================================
-
-c   ...  Dans inigeom , nouveaux calculs pour les elongations  cu , cv 
-c        et possibilite d'appeler une fonction f(y)  a derivee tangente 
-c        hyperbolique a la  place de la fonction a derivee sinusoidale.         
-
-c   ...  Possibilite de choisir le shema de Van-leer pour l'advection de
-c         q  , en faisant iadv = 3  dans   traceur  (29/04/97) .
-c
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissnew.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "logic.h"
-#include "temps.h"
-#include "control.h"
-#include "ener.h"
-#include "netcdf.inc"
-#include "description.h"
-#include "serre.h"
-#include "tracstoke.h"
-
-      INTEGER nid
-      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_latv
-      INTEGER idim_s, idim_sig, idim_tim
-
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
-      SAVE  clesphy0
-
-      INTEGER*4  iday ! jour julien
-      REAL       time ! Heure de la journee en fraction d'1 jour
-      REAL zdtvr
-      INTEGER nbetatmoy, nbetatdem,nbetat
-
-c   variables dynamiques
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL teta(ip1jmp1,llm)                 ! temperature potentielle 
-      REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
-      REAL ps(ip1jmp1)                       ! pression  au sol
-      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
-      REAL pks(ip1jmp1)                      ! exner au  sol
-      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
-      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
-      REAL masse(ip1jmp1,llm)                ! masse d'air
-      REAL phis(ip1jmp1)                     ! geopotentiel au sol
-      REAL phi(ip1jmp1,llm)                  ! geopotentiel
-      REAL w(ip1jmp1,llm)                    ! vitesse verticale
-
-c variables dynamiques intermediaire pour le transport
-      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm) !flux de masse
-
-c   variables dynamiques au pas -1
-      REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
-      REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1)
-      REAL massem1(ip1jmp1,llm)
-
-c   tendances dynamiques
-      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
-      REAL dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
-
-c   tendances de la dissipation
-      REAL dvdis(ip1jm,llm),dudis(ip1jmp1,llm)
-      REAL dhdis(ip1jmp1,llm)
-
-c   tendances physiques
-      REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
-      REAL dhfi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
-
-c   variables pour le fichier histoire
-      REAL dtav      ! intervalle de temps elementaire
-
-      REAL tppn(iim),tpps(iim),tpn,tps
-c
-      INTEGER iadv(nqmx) ! indice schema de transport pour le traceur iq
-
-      INTEGER itau,itaufinp1,iav
-
-      EXTERNAL caldyn, traceur
-      EXTERNAL dissip,geopot,iniconst,inifilr
-      EXTERNAL integrd,SCOPY
-      EXTERNAL inigeom
-      EXTERNAL exner_hyb,addit
-      EXTERNAL defrun_new, test_period
-      REAL  SSUM
-      REAL time_0 , finvmaold(ip1jmp1,llm)
-
-      LOGICAL lafin
-      INTEGER ij,iq,j,i,l,numvanle,iapp_tracvl
-
-
-      integer histid, histvid, histaveid
-      real time_step, t_wrt, t_ops
-      integer itime_step
-      character*80 dynhist_file, dynhistave_file
-
-
-      REAL rdayvrai,rdaym_ini,rday_ecri
-      LOGICAL first
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
-CMAF pour rajout injection
-      real lon_stat,lat_stat
-      integer i_stat,j_stat
-      LOGICAL injecte
-      DATA injecte/.true./
-      integer ijstat
-CMAF
-cAA
-      character*10 file
-cAA
-
-c-----------------------------------------------------------------------
-c   Initialisations:
-c   ----------------
-
-      descript = 'Run GCM LMDZ'
-      lafin    = .FALSE.
-
-c-----------------------------------------------------------------------
-c
-c  ....  Choix  des shemas d'advection pour l'eau et les traceurs  ...
-c  ...................................................................
-c
-c     iadv = 1    shema  transport type "humidite specifique LMD"  
-c     iadv = 2    shema   amont
-c     iadv = 3    shema  Van-leer
-c 
-c     dans le tableau q(ij,l,iq) , iq = 1  pour l'eau vapeur
-c                                , iq = 2  pour l'eau liquide
-c         et eventuellement      , iq = 3, nqmx pour les autres traceurs
-c
-c     iadv(1): choix pour l'eau vap. et  iadv(2) : choix pour l'eau liq.
-c
-      DO iq = 1, nqmx
-       iadv( iq ) = 3
-      ENDDO
-c
-      DO  iq = 1, nqmx
-       IF( iadv(iq).EQ.1 ) PRINT *,' Choix du shema humidite specifique'
-     * ,' pour le traceur no ', iq
-       IF( iadv(iq).EQ.2 ) PRINT *,' Choix du shema  amont',' pour le'
-     * ,' traceur no ', iq
-       IF( iadv(iq).EQ.3 ) PRINT *,' Choix du shema  Van-Leer ',' pour'
-     * ,'le traceur no ', iq
-       IF( iadv(iq).LE.0.OR.iadv(iq).GT.3 )   THEN
-       PRINT *,' Erreur dans le  choix de  iadv . Corriger et repasser
-     * . '
-         STOP 
-       ENDIF
-      ENDDO
-c
-      first = .TRUE.
-      numvanle = nqmx + 1
-      DO  iq = 1, nqmx
-        IF( iadv(iq).EQ.3.AND.first ) THEN
-          numvanle = iq
-          first    = .FALSE.
-        ENDIF
-      ENDDO
-c
-      DO  iq = 1, nqmx
-        IF( iadv(iq).NE.3.AND.iq.GT.numvanle )   THEN
-          PRINT *,' Il y a discontinuite dans le choix du shema de ',
-     *    'Van-leer pour les traceurs . Corriger et repasser . '
-           STOP
-        ENDIF
-        IF( iadv(iq).LT.1.OR.iadv(iq).GT.3 )    THEN
-          PRINT *,' Le choix de  iadv  est errone pour le traceur ',
-     *    iq
-         STOP
-        ENDIF
-      ENDDO
-c
-
-      CALL dynetat0("start.nc",nqmx,vcov,ucov,
-     .              teta,q,masse,ps,phis, time_0)
-
-      OPEN( 99,file ='run.def',status='old',form='formatted')
-      CALL defrun_new( 99, .TRUE. , clesphy0 )
-      CLOSE(99)
-
-c  on recalcule eventuellement le pas de temps
-
-      IF(MOD(day_step,iperiod).NE.0)
-     * STOP'Il faut choisir un nb de pas par jour multiple de iperiod'
-
-      IF(MOD(day_step,iphysiq).NE.0)
-     * STOP'Il faut choisir un nb de pas par jour multiple de iphysiq'
-
-      zdtvr    = daysec/FLOAT(day_step)
-        IF(dtvr.NE.zdtvr) THEN
-         PRINT*,'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
-        ENDIF
-
-c  nombre d'etats dans les fichiers demarrage et histoire
-      nbetatdem = nday / iecri
-      nbetatmoy = nday / periodav + 1
-
-      dtvr = zdtvr
-      CALL iniconst
-      CALL inigeom
-
-      CALL inifilr
-c
-c   ......    P.Le Van    ( modif  le 29/04/97 )   .........  
-c
-      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
-     *                tetagdiv, tetagrot , tetatemp              )
-c
-
-      CALL pression ( ip1jmp1, ap, bp, ps, p       )
-      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-c
-
-c  numero de stockage pour les fichiers de redemarrage:
-
-c-----------------------------------------------------------------------
-c   temps de depart et de fin:
-c   --------------------------
-
-      itau = 0
-      iday = day_ini+itau/day_step
-      time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
-         IF(time.GT.1.) THEN
-          time = time-1.
-          iday = iday+1
-         ENDIF
-      itaufin   = nday*day_step
-      itaufinp1 = itaufin +1
-
-      day_end = day_ini + nday
-      PRINT 300, itau,itaufin,day_ini,day_end
-
-      CALL dynredem0("restart.nc",day_end,anne_ini,phis,nqmx)
-      CALL dynhist0("histoire.nc",day_ini,anne_ini,phis,nqmx)
-
-      ecripar = .TRUE.
-
-      dtav = iperiod*dtvr/daysec
-      dynhistave_file = 'histmoy.nc'
-      t_ops = iperiod*dtvr
-      t_wrt = periodav * daysec
-      CALL initdynav(dynhistave_file,day_ini,anne_ini,dtvr,
-     .              t_ops, t_wrt, nqmx, histaveid)
-
-
-c   Quelques initialisations pour les traceurs
-      call initial0(ijp1llm*nqmx,dq)
-      istdyn=day_step/4     ! stockage toutes les 6h=1jour/4
-      istphy=istdyn/iphysiq
-
-c-----------------------------------------------------------------------
-c   Debut de l'integration temporelle:
-c   ----------------------------------
-
-   1  CONTINUE
-c
-      IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
-         CALL  test_period ( ucov,vcov,teta,q,p,phis )
-         PRINT *,' ----   Test_period   OK ! -----', itau
-      ENDIF 
-c
-      CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
-      CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
-      CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 )
-      CALL SCOPY( ijp1llm,masse, 1, massem1, 1 )
-      CALL SCOPY( ip1jmp1, ps  , 1,   psm1 , 1 )
-
-      forward = .TRUE.
-      leapf   = .FALSE.
-      dt      =  dtvr
-
-c   ...    P.Le Van .26/04/94  ....
-
-      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
-      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
-
-
-   2  CONTINUE
-
-c-----------------------------------------------------------------------
-
-c   date:
-c   -----
-
-
-c   gestion des appels de la physique et des dissipations:
-c   ------------------------------------------------------
-c
-c   ...    P.Le Van  ( 6/02/95 )  ....
-
-      apphys = .FALSE.
-      statcl = .FALSE.
-      conser = .FALSE.
-      apdiss = .FALSE.
-
-      IF( purmats ) THEN
-         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
-         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
-         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 
-     $                              .AND.   physic    ) apphys = .TRUE.
-      ELSE
-         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
-         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
-         IF( MOD(itau+1,iphysiq).EQ.0. AND. physic    ) apphys = .TRUE.
-      END IF
-
-c-----------------------------------------------------------------------
-c   calcul des tendances dynamiques:
-c   --------------------------------
-
-      CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
-c
-c
-      CALL caldyn 
-     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
-     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time+iday-day_ini )
-
-c-----------------------------------------------------------------------
-c   calcul des tendances advection des traceurs (dont l'humidite)
-c   -------------------------------------------------------------
-
-      IF( forward. OR . leapf )  THEN
-c
-        if (injecte) then
-            injecte=.false.
-c On injecte tous les traceurs de la meme facon
-C injection au debut de la simulation
-C !! MAF dans code pi en radians et lat lon en degrees => conversion
-C injection au point -2, 48 en lat lon
-            lon_stat= -2.
-            lat_stat= 48.
-C
-            pi=2.*asin(1.)
-            lon_stat=lon_stat*pi/180.
-            lat_stat=lat_stat*pi/180.
-            CALL coordij(lon_stat,lat_stat,i_stat,j_stat)
-
-            print*,'INJECTION AU POINT ',lon_stat,lat_stat
-     s      ,'     I,J=',i_stat,j_stat,jjp1-j_stat+1
-            ijstat=(j_stat-1)*iip1+i_stat
-C cas avec rnpb on commence a injecter pour le traceur 5
-            do iq=5,nqmx
-               q(ijstat,1,iq)=
-     s         +1.e12/masse(ijstat,1)
-            enddo
-        endif
-
-        DO 15  iq = 1, nqmx
-c
-         IF( iadv(iq).EQ.1.OR.iadv(iq).EQ.2 )  THEN
-           CALL traceur( iq,iadv,q,teta,pk,w, pbaru, pbarv, dq )
-
-         ELSE IF( iq.EQ. nqmx )   THEN
-c
-            iapp_tracvl = 5
-c
-cccc     iapp_tracvl est la frequence en pas du groupement des flux
-cccc      de masse pour  Van-Leer dans la routine  tracvl  .
-c
-            CALL vanleer(numvanle,iapp_tracvl,nqmx,q,pbaru,pbarv,
-     *                             p,  masse, dq                  )
-c
-         ENDIF
-c
- 15     CONTINUE
-C
-Cmaf stokage du flux de masse pour traceurs OFF-LINE
-          CALL fluxstoke(pbaru,pbarv,masse,teta,phi,phis)
-c
-      ENDIF
-
-
-c-----------------------------------------------------------------------
-c   integrations dynamique et traceurs:
-c   ----------------------------------
-
-       CALL integrd ( iadv, 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
-     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
-     $              finvmaold                                    )
-
-c .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
-c
-c-----------------------------------------------------------------------
-c   calcul des tendances physiques:
-c   -------------------------------
-c    ########   P.Le Van ( Modif le  6/02/95 )   ###########
-c
-       IF( purmats )  THEN
-          IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.
-       ELSE
-          IF( itau+1. EQ. itaufin )              lafin = .TRUE.
-       ENDIF
-c
-c
-       IF( apphys )  THEN
-c
-c     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
-c
-
-         CALL pression (  ip1jmp1, ap, bp, ps,  p      )
-         CALL exner_hyb(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
-
-           rdaym_ini  = itau * dtvr / daysec
-           rdayvrai   = rdaym_ini  + day_ini
-
-           IF ( ecritphy.LT.1. )  THEN
-             rday_ecri = rdaym_ini
-           ELSE
-             rday_ecri = NINT( rdayvrai )
-           ENDIF
-c
-C MAF le dernier traceur ne passe pas dans la physique 
-C nqmx => nqmx -1 dans calfis et addfi
-C
-        CALL calfis( nqmx-1, lafin ,rdayvrai,rday_ecri,time  ,
-     $                 ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
-     $     du,dv,dteta,dq,w,clesphy0, dufi,dvfi,dhfi,dqfi,dpfi  )
-
-c      ajout des tendances physiques:
-c      ------------------------------
-          CALL addfi( nqmx-1, dtphys, leapf, forward   ,
-     $                  ucov, vcov, teta , q   ,ps ,
-     $                 dufi, dvfi, dhfi , dqfi ,dpfi  )
-c
-       ENDIF
-
-        CALL pression ( ip1jmp1, ap, bp, ps, p                  )
-        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-
-c-----------------------------------------------------------------------
-c
-c
-c   dissipation horizontale et verticale  des petites echelles:
-c   ----------------------------------------------------------
-
-      IF(apdiss) THEN
-
-         CALL dissip(vcov,ucov,teta,p,dvdis,dudis,dhdis)
-
-         CALL addit( ijp1llm,ucov ,dudis,ucov )
-         CALL addit( ijmllm ,vcov ,dvdis,vcov )
-         CALL addit( ijp1llm,teta ,dhdis,teta )
-
-
-c    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
-c   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
-c
-      IF( alphax.NE. 0. ) THEN
-
-        DO l  =  1, llm
-          DO ij =  1,iim
-           tppn(ij)  = aire(  ij    ) * teta(  ij    ,l)
-           tpps(ij)  = aire(ij+ip1jm) * teta(ij+ip1jm,l)
-          ENDDO
-           tpn  = SSUM(iim,tppn,1)/apoln
-           tps  = SSUM(iim,tpps,1)/apols
-
-          DO ij = 1, iip1
-           teta(  ij    ,l) = tpn
-           teta(ij+ip1jm,l) = tps
-          ENDDO
-        ENDDO
-
-      ENDIF
-
-      END IF
-        
-c   ********************************************************************
-c   ********************************************************************
-c   .... fin de l'integration dynamique  et physique pour le pas itau ..
-c   ********************************************************************
-c   ********************************************************************
-
-c   preparation du pas d'integration suivant  ......
-
-      IF ( .NOT.purmats ) THEN
-c       ........................................................
-c       ..............  schema matsuno + leapfrog  ..............
-c       ........................................................
-
-            IF(forward. OR. leapf) THEN
-              itau= itau + 1
-              iday= day_ini+itau/day_step
-              time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
-                IF(time.GT.1.) THEN
-                  time = time-1.
-                  iday = iday+1
-                ENDIF
-            ENDIF
-
-
-C            IF( itau. EQ. itaufinp1 )    STOP
-            IF( itau. EQ. itaufinp1 )    goto 200
-
-
-c-----------------------------------------------------------------------
-c   ecriture du fichier histoire moyenne:
-c   -------------------------------------
-
-            IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
-               IF(itau.EQ.itaufin) THEN
-                  iav=1
-               ELSE
-                  iav=0
-               ENDIF
-               CALL writedynav(histaveid, nqmx, itau,vcov ,
-     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
-
-            ENDIF
-
-c-----------------------------------------------------------------------
-c   ecriture de la bande histoire:
-c   ------------------------------
-
-            IF( MOD(itau,iecri*day_step).EQ.0) THEN
-
-               nbetat = nbetatdem
-       CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi        )
-       CALL dynhist1("histoire.nc",time+iday-day_ini,
-     .                     vcov,ucov,teta,q,nqmx,masse,ps)
-
-
-            ENDIF
-
-            IF(itau.EQ.itaufin) THEN
-
-       CALL dynredem1("restart.nc",0.0,
-     .                     vcov,ucov,teta,q,nqmx,masse,ps)
-
-              CLOSE(99)
-            ENDIF
-
-c-----------------------------------------------------------------------
-c   gestion de l'integration temporelle:
-c   ------------------------------------
-
-            IF( MOD(itau,iperiod).EQ.0 )    THEN
-                    GO TO 1
-            ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN
-
-                   IF( forward )  THEN
-c      fin du pas forward et debut du pas backward
-
-                      forward = .FALSE.
-                        leapf = .FALSE.
-                           GO TO 2
-
-                   ELSE
-c      fin du pas backward et debut du premier pas leapfrog
-
-                        leapf =  .TRUE.
-                        dt  =  2.*dtvr
-                        GO TO 2
-                   END IF
-            ELSE
-
-c      ......   pas leapfrog  .....
-
-                 leapf = .TRUE.
-                 dt  = 2.*dtvr
-                 GO TO 2
-            END IF
-
-      ELSE
-
-c       ........................................................
-c       ..............       schema  matsuno        ...............
-c       ........................................................
-            IF( forward )  THEN
-
-             itau =  itau + 1
-             iday = day_ini+itau/day_step
-             time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0
-
-                  IF(time.GT.1.) THEN
-                   time = time-1.
-                   iday = iday+1
-                  ENDIF
-
-               forward =  .FALSE.
-C            IF( itau. EQ. itaufinp1 )    STOP
-            IF( itau. EQ. itaufinp1 )    goto 200
-
-               GO TO 2
-
-            ELSE
-
-            IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
-               IF(itau.EQ.itaufin) THEN
-                  iav=1
-               ELSE
-                  iav=0
-               ENDIF
-               CALL writedynav(histaveid, nqmx, itau,vcov ,
-     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
-
-            ENDIF
-
-               IF(MOD(itau,iecri*day_step).EQ.0) THEN
-                  nbetat = nbetatdem
-       CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi       )
-      CALL dynhist1("histoire.nc",time+iday-day_ini,
-     .                     vcov,ucov,teta,q,nqmx,masse,ps)
-
-               ENDIF
-
-                 IF(itau.EQ.itaufin)
-     . CALL dynredem1("restart.nc",0.0,
-     .                     vcov,ucov,teta,q,nqmx,masse,ps)
-
-                 forward = .TRUE.
-                 GO TO  1
-
-            ENDIF
-
-      END IF
-
- 200  continue
-      call histclo
-
-
- 300  FORMAT('1'/15x'run du pas'i7,2x,'au pas'i7,2x,  'c"est a dire du
-     * jour'i7,3x'au jour'i7//)
-
-      STOP
-      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/gr_ecrit_fi.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/gr_ecrit_fi.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/gr_ecrit_fi.F	(revision 497)
@@ -0,0 +1,29 @@
+	SUBROUTINE gr_ecrit_fi(nfield,nlon,iim,jjmp1,ecrit,fi)
+
+	IMPLICIT none
+
+c Transformer une variable de la grille d'ecriture a la grille physique
+	
+	INTEGER nfield,nlon,iim,jjmp1, jjm
+      REAL fi(nlon,nfield), ecrit(iim,jjmp1,nfield)
+c
+      INTEGER i, j, n, ig
+c
+c	print*,'iim jjm ',iim,jjm
+
+c modif par abd 21 02 01
+
+        jjm = jjmp1 - 1
+	do n = 1, nfield
+	    fi(1,n) = ecrit(1,1,n)
+            fi(nlon,n) = ecrit(1,jjm+1,n)
+         DO j = 2, jjm
+            ig = 2+(j-2)*iim
+            DO i = 1, iim
+	     fi(ig-1+i,n) = ecrit(i,j,n)
+            ENDDO
+         ENDDO
+      ENDDO
+      RETURN
+      END
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/grid_noro.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/grid_noro.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/grid_noro.F	(revision 497)
@@ -1,3 +1,5 @@
-
+c
+c $Header$
+c
       SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
      .             imar, jmar, x, y,
@@ -52,5 +54,5 @@
       IMPLICIT REAL(X,Z) 
       
-	  parameter(iusn=2160,jusn=1080,iext=216)
+	  parameter(iusn=2160,jusn=1080,iext=216, epsfra = 1.e-5)
 #include "dimensions.h"
 	  REAL xusn(iusn+2*iext),yusn(jusn+2)	
@@ -77,8 +79,10 @@
       REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
       REAL zpic(imar+1,jmar),zval(imar+1,jmar)
-      integer mask(imar+1,jmar)
+c$$$ PB     integer mask(imar+1,jmar)
+      real mask(imar+1,jmar), mask_tmp(imar+1,jmar)
       real num_tot(2200,1100),num_lan(2200,1100)
 c
       REAL a(2200),b(2200),c(1100),d(1100)
+      logical masque_lu
 c
       print *,' parametres de l orographie a l echelle sous maille' 
@@ -86,4 +90,13 @@
       rad    = 6 371 229.
       zdeltay=2.*xpi/float(jusn)*rad
+c
+c utilise-t'on un masque lu?
+c
+      masque_lu = .true.
+      if (maxval(mask) == -99999 .and. minval(mask) == -99999) then
+        masque_lu= .false.
+        masque = 0.0
+      endif
+      write(*,*)'Masque lu', masque_lu
 c
 c  quelques tests de dimensions:
@@ -257,9 +270,12 @@
          IF (weight(ii,jj) .NE. 0.0) THEN
 c  Mask
-           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
-             mask(ii,jj)=1
-           else
-             mask(ii,jj)=0
-           endif
+c$$$           if(num_lan(ii,jj)/num_tot(ii,jj).ge.0.5)then
+c$$$             mask(ii,jj)=1
+c$$$           else
+c$$$             mask(ii,jj)=0
+c$$$           ENDIF
+             if (.not. masque_lu) then
+               mask(ii,jj) = num_lan(ii,jj)/num_tot(ii,jj)
+             endif
 c  Mean Orography:
            zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
@@ -296,6 +312,11 @@
        CALL MVA9(zval,iim+1,jjm+1)
        CALL MVA9(zxtzx,iim+1,jjm+1)
-       CALL MVA9(zxtzy,iim+1,jjm+1)
+       CALL MVA9(zxtzy,iim+1,jjm+1) 
        CALL MVA9(zytzy,iim+1,jjm+1)
+C$$$   Masque prenant en compte maximum de terre
+C$$$  On seuil a 10% de terre de terre car en dessous les parametres de surface n'on
+C$$$ pas de sens (PB)
+       mask_tmp= 0.0
+       WHERE(mask .GE. 0.1) mask_tmp = 1.
 
        DO ii = 1, imar
@@ -313,15 +334,26 @@
            if(abs(xm).le.xw) xm=xw*sign(1.,xm)
 c slope: 
-           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
+c$$$           zsig(ii,jj)=sqrt(xq)*mask(ii,jj)
+c$$$c isotropy:
+c$$$           zgam(ii,jj)=xp/xq*mask(ii,jj)
+c$$$c angle theta:
+c$$$           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
+c$$$           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+c$$$           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
+c$$$           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
+c$$$           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
+c$$$           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
+C$$* PB modif pour maque de terre fractionnaire
+c slope: 
+           zsig(ii,jj)=sqrt(xq)*mask_tmp(ii,jj)
 c isotropy:
-           zgam(ii,jj)=xp/xq*mask(ii,jj)
+           zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
 c angle theta:
-           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask(ii,jj)
-           zphi(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-           zmea(ii,jj)=zmea(ii,jj)*mask(ii,jj)
-           zpic(ii,jj)=zpic(ii,jj)*mask(ii,jj)
-           zval(ii,jj)=zval(ii,jj)*mask(ii,jj)
-           zstd(ii,jj)=zstd(ii,jj)*mask(ii,jj)
-
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.*mask_tmp(ii,jj)
+           zphi(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
+           zmea(ii,jj)=zmea(ii,jj)*mask_tmp(ii,jj)
+           zpic(ii,jj)=zpic(ii,jj)*mask_tmp(ii,jj)
+           zval(ii,jj)=zval(ii,jj)*mask_tmp(ii,jj)
+           zstd(ii,jj)=zstd(ii,jj)*mask_tmp(ii,jj)
 c          print 101,ii,jj,
 c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
@@ -341,5 +373,4 @@
        ENDDO
        ENDDO
-
       print *,'  MEAN ORO:',zllmmea
       print *,'  ST. DEV.:',zllmstd
@@ -355,4 +386,5 @@
       DO jj=1,jmar
       zmea(imar+1,jj)=zmea(1,jj)
+      zphi(imar+1,jj)=zphi(1,jj)
       zpic(imar+1,jj)=zpic(1,jj)
       zval(imar+1,jj)=zval(1,jj)
@@ -420,5 +452,5 @@
       PARAMETER (ISMo=300,JSMo=200)
       REAL X(IMAR,JMAR),XF(ISMo,JSMo)
-      real weight(-1:1,-1:1)
+      real WEIGHTpb(-1:1,-1:1)
 
       if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
@@ -427,50 +459,53 @@
       SUM=0.
       DO IS=-1,1
-      DO JS=-1,1
-      WEIGHT(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
-      SUM=SUM+WEIGHT(IS,JS)
-      ENDDO
-      ENDDO
-
+        DO JS=-1,1
+          WEIGHTpb(IS,JS)=1./FLOAT((1+IS**2)*(1+JS**2))
+          SUM=SUM+WEIGHTpb(IS,JS)
+        ENDDO
+      ENDDO
+      
+c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
+c     WRITE(*,*) 'MVA9 ', WEIGHTpb
+c     WRITE(*,*) 'MVA9 SUM ', SUM
       DO IS=-1,1
-      DO JS=-1,1
-      WEIGHT(IS,JS)=WEIGHT(IS,JS)/SUM
-      ENDDO
+        DO JS=-1,1
+          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
+        ENDDO
       ENDDO
 
       DO J=2,JMAR-1
-      DO I=2,IMAR-1
-      XF(I,J)=0.
-      DO IS=-1,1
-      DO JS=-1,1
-         XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHT(IS,JS)
-      ENDDO
-      ENDDO
-      ENDDO
+        DO I=2,IMAR-1
+          XF(I,J)=0.
+          DO IS=-1,1
+            DO JS=-1,1
+              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
+            ENDDO
+          ENDDO
+        ENDDO
       ENDDO
 
       DO J=2,JMAR-1
-         XF(1,J)=0.
-      IS=IMAR-1
-      DO JS=-1,1 
-         XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHT(-1,JS)
-      ENDDO
-      DO IS=0,1 
-      DO JS=-1,1 
-         XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHT(IS,JS)
-      ENDDO
-      ENDDO
-         XF(IMAR,J)=XF(1,J)
+        XF(1,J)=0.
+        IS=IMAR-1
+        DO JS=-1,1 
+          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
+        ENDDO
+        DO IS=0,1 
+          DO JS=-1,1 
+            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
+          ENDDO
+        ENDDO
+        XF(IMAR,J)=XF(1,J)
       ENDDO
 
       DO I=1,IMAR
-      XF(I,1)=XF(I,2)
-      XF(I,JMAR)=XF(I,JMAR-1)
+        XF(I,1)=XF(I,2)
+        XF(I,JMAR)=XF(I,JMAR-1)
       ENDDO
 
       DO I=1,IMAR
-      DO J=1,JMAR
-         X(I,J)=XF(I,J)
-      ENDDO
+        DO J=1,JMAR
+          X(I,J)=XF(I,J)
+        ENDDO
       ENDDO
 
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/grilles_gcm_netcdf.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/grilles_gcm_netcdf.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/grilles_gcm_netcdf.F	(revision 497)
@@ -0,0 +1,286 @@
+c
+c $Header$
+c
+
+      PROGRAM create_fausse_var
+C
+      IMPLICIT NONE
+C
+C
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comvert.h"
+
+      real temp(iim+1,jjm+1)
+#include "netcdf.inc"
+
+c Attributs netcdf sortie
+        character*64 fich_out
+        integer*4 ncid_out,rcode_out
+        integer*4 out_lonuid,out_lonvid,out_latuid,out_latvid
+        integer*4 out_varid
+        integer*4 out_lonudim,out_lonvdim
+        integer*4 out_latudim,out_latvdim,out_dim(3)
+
+      INTEGER         longcles
+      PARAMETER     ( longcles = 20 )
+      REAL  clesphy0( longcles )
+
+      integer start(4),count(4)
+
+	integer status,i,j
+        real rlatudeg(jjp1),rlatvdeg(jjm)
+        real rlonudeg(iip1),rlonvdeg(iip1)
+
+      real dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
+      real acoslat,dxkm,dykm,resol(iip1,jjp1)
+
+#include "serre.h"
+#include "fxyprim.h"
+
+      print*,'OK0'
+
+      rad = 6400000
+      omeg = 7.272205e-05
+      g = 9.8
+      kappa = 0.285716
+      daysec = 86400
+      cpp = 1004.70885
+
+      preff = 101325.
+      pa= 50000.
+
+      open(99,file='run.def',status='old',form='formatted')
+      CALL defrun_new( 99, .TRUE.,clesphy0 )
+      close(99)
+      CALL iniconst
+      CALL inigeom
+
+
+      print*,'OK1'
+      do j=1,jjp1
+         rlatudeg(j)=rlatu(j)*180./pi
+      enddo
+      do j=1,jjm
+         rlatvdeg(j)=rlatv(j)*180./pi
+      enddo
+
+      do i=1,iip1
+         rlonudeg(i)=rlonu(i)*180./pi
+         rlonvdeg(i)=rlonv(i)*180./pi
+      enddo
+
+
+      print*,'OK2'
+c  2 ----- OUVERTURE DE LA SORTIE NETCDF
+c ---------------------------------------------------
+c CREATION OUTPUT
+c ouverture fichier netcdf de sortie out
+        fich_out='grilles_gcm.nc'
+
+        status=NF_CREATE(fich_out,NF_NOCLOBBER,ncid_out)
+        status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim)
+        status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim)
+        status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim)
+        status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim)
+
+
+      print*,'OK3'
+c   Longitudes en u
+        print *,'OUTID: ',ncid_out
+        status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim,
+     %  out_lonuid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units',
+     %  12,'degrees_east')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',
+     %  9,'Longitude en u')
+
+c   Longitudes en v
+        print *,'OUTID: ',ncid_out
+        status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim,
+     %  out_lonvid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units',
+     %  12,'degrees_east')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name',
+     %  9,'Longitude en v')
+
+c   Latitude en u
+        status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim,
+     %  out_latuid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units',
+     %  13,'degrees_north')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name',
+     %  8,'Latitude en u')
+
+c  Latitude en v
+        status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim,
+     %  out_latvid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units',
+     %  13,'degrees_north')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name',
+     %  8,'Latitude en v')
+
+c   ecriture de la grille u
+        out_dim(1)=out_lonudim
+        out_dim(2)=out_latudim
+        status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim,
+     %  out_varid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
+     %  6,'Kelvin')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
+     %  16,'Grille aux point u')
+
+c   ecriture de la grille v
+        out_dim(1)=out_lonvdim
+        out_dim(2)=out_latvdim
+        status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim,
+     %  out_varid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
+     %  6,'Kelvin')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
+     %  16,'Grille aux point v')
+
+c   ecriture de la grille u
+        out_dim(1)=out_lonvdim
+        out_dim(2)=out_latudim
+        status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim,
+     %  out_varid)
+        call handle_err(status)
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units',
+     %  6,'Kelvin')
+        status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',
+     %  16,'Grille aux point u')
+
+
+      print*,'OK4'
+        status=NF_ENDDEF(ncid_out)
+c 5) ----- FERMETURE DES FICHIERS NETCDF------------------
+c --------------------------------------------------------
+c 3-b- Ecriture de la grille pour la sortie
+c rajoute l'ecriture de la grille
+
+#ifdef NC_DOUBLE
+      status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg)
+      status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
+      status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg)
+      status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg)
+#else
+      status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg)
+      status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg)
+      status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg)
+      status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg)
+#endif
+
+        start(1)=1
+        start(2)=1
+        start(3)=1
+        start(4)=1
+
+        count(1)=iim+1
+        count(2)=jjm+1
+        count(3)=1
+        count(4)=1
+
+        do j=1,jjm+1
+           do i=1,iim+1
+              temp(i,j)=mod(i,2)+mod(j,2)
+           enddo
+        enddo
+
+#ifdef NC_DOUBLE
+        status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start,
+     s  count,temp)
+#else
+        status=NF_PUT_VARA_REAL(ncid_out,out_varid,start,
+     s  count,temp)
+#endif
+
+
+c fermeture du fichier netcdf
+        call ncclos(ncid_out,rcode_out)
+        write(*,*) 'Fermeture: ',fich_out
+
+
+      print*,'OK5'
+c   Ecriture grads
+      open (20,file='grille.dat',form='unformatted',access='direct'
+     s      ,recl=4*ip1jmp1)
+      write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)
+      write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)
+      do j=2,jjm
+         dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi
+c        dlat2(j)=180.*fyprim(float(j))/pi
+      enddo
+      do i=2,iip1
+         dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi
+c        dlon2(i)=180.*fxprim(float(i))/pi
+      enddo
+      do j=2,jjm
+         dykm=(rlatv(j)-rlatv(j-1))*6400.
+         acoslat=6400.*cos(rlatu(j))
+         do i=2,iip1
+            dxkm=acoslat*(rlonu(i)-rlonu(i-1))
+            resol(i,j)=sqrt(dykm*dykm+dxkm*dxkm)
+         enddo
+         resol(1,j)=resol(iip1,j)
+      enddo
+      write(20,rec=3) resol
+      dlon1(1)=dlon1(iip1)
+      dlon2(1)=dlon2(iip1)
+      write(20,rec=4) ((dlon1(i),i=1,iip1),j=1,jjp1)
+      write(20,rec=5) ((dlon2(i),i=1,iip1),j=1,jjp1)
+      write(20,rec=6) ((dlat1(j),i=1,iip1),j=1,jjp1)
+      write(20,rec=7) ((dlat2(j),i=1,iip1),j=1,jjp1)
+        
+      open (21,file='grille.ctl',form='formatted')
+
+c   WARNING! on reecrase le fichier .ctl a chaque ecriture
+      write(21,'(a5,1x,a40)')
+     &       'DSET ','^grille.dat'
+
+      write(21,'(a12)') 'UNDEF 1.0E30'
+      write(21,'(a5,1x,a40)') 'TITLE ','grille'
+      call formcoord(21,iip1,rlonv,180./pi,.false.,'XDEF')
+      call formcoord(21,jjp1,rlatu,180./pi,.true.,'YDEF')
+      call formcoord(21,1,0.,1.,.false.,'ZDEF')
+      write(21,'(a4,i10,a30)')
+     &       'TDEF ',1,' LINEAR 23OCT1994 3hr '
+      write(21,'(a4,2x,i5)') 'VARS',7
+      write(21,'(a18)') 'grille 0 99 grille'
+      write(21,'(a18)') 'gril   0 99 gril  '
+      write(21,'(a29)') 'resol   0 99 resolution (km)  '
+      write(21,'(a18)') 'dlon1  0 99 dlon1 '
+      write(21,'(a18)') 'dlon2  0 99 dlon2 '
+      write(21,'(a18)') 'dlat1  0 99 dlat1 '
+      write(21,'(a18)') 'dlat2  0 99 dlat2 '
+      write(21,'(a7)') 'ENDVARS'
+
+
+
+
+
+      print*,'OK6'
+	end
+
+
+
+        subroutine handle_err(status)
+#include "netcdf.inc"
+
+
+        integer status
+        print *,'handle code err: ',NF_NOERR
+        IF (status.NE.nf_noerr) THEN
+                print *,NF_STRERROR(status)
+                stop 'stopped'
+        ENDIF
+        END
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/heavyside.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/heavyside.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/heavyside.F	(revision 497)
@@ -0,0 +1,21 @@
+c
+c $Header$
+c
+       FUNCTION heavyside(a)
+
+c      ...   P. Le Van  ....
+c
+       IMPLICIT NONE
+
+       REAL*8 heavyside , a
+
+       IF ( a.LE.0. )  THEN
+         heavyside = 0.
+       ELSE
+         heavyside = 1.
+       ENDIF
+
+       RETURN
+       END
+
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inigeom.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/inigeom.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inigeom.F	(revision 497)
@@ -1,22 +1,18 @@
+c
+c $Header$
+c
       SUBROUTINE inigeom
 c
 c     Auteur :  P. Le Van
-c    .....................
-c
-c   ............      Version  du 20/12/98     ........................
+c
+c   ............      Version  du 01/04/2001     ........................
 c
 c  Calcul des elongations cuij1,.cuij4 , cvij1,..cvij4  aux memes en-
 c     endroits que les aires aireij1,..aireij4 .
+
 c  Choix entre f(y) a derivee sinusoid. ou a derivee tangente hyperbol.
 c
 c
       IMPLICIT NONE
-c
-      REAL        deltay, tauy, taux
-      PARAMETER ( deltay =  0. , tauy = 1. , taux = 1. )
-c
-c     deltay  est ( en degres ) le deplacement eventuel en Y du zoom
-cc    taux  et  tauy  sont  les raideurs   du  zoom
-c
 c
 #include "dimensions.h"
@@ -50,10 +46,6 @@
       SAVE rlonm025,xprimm025,rlonp025,xprimp025
 
-
-
-c----------------------------------------------------------------------
       REAL      SSUM
       EXTERNAL  SSUM
-c
 c
 c
@@ -62,5 +54,4 @@
 c   -    calcul des coeff. ( cu, cv , 1./cu**2,  1./cv**2  )         -
 c   -                                                                -
-c   ------------------------------------------------------------------
 c   ------------------------------------------------------------------
 c
@@ -168,5 +159,5 @@
 c
 c
-      PRINT 3
+      WRITE(6,3) 
  3    FORMAT( // 10x,' ....  INIGEOM  date du 01/06/98   ..... ',
      * //5x,'   Calcul des elongations cu et cv  comme sommes des 4 ' /
@@ -191,10 +182,10 @@
       ENDIF
 
-      PRINT *,' gamdi_gd ',gamdi_gdiv,gamdi_grot,gamdi_h,coefdis,
+      WRITE(6,*) ' gamdi_gd ',gamdi_gdiv,gamdi_grot,gamdi_h,coefdis,
      *  nitergdiv,nitergrot,niterh
 c
       pi    = 2.* ASIN(1.)
 c
-      PRINT 990
+      WRITE(6,990) 
 
 c     ----------------------------------------------------------------
@@ -205,5 +196,5 @@
        IF( ysinus )  THEN
 c
-        PRINT *,' ***  Inigeom ,  Y = Sinus ( Latitude ) *** '
+        WRITE(6,*) ' ***  Inigeom ,  Y = Sinus ( Latitude ) *** '
 c
 c   .... utilisation de f(x,y )  avec  y  =  sinus de la latitude  .....
@@ -215,5 +206,5 @@
        ELSE
 c
-        PRINT *,' *** Inigeom ,  Y = Latitude  , der. sinusoid . ***'
+        WRITE(6,*) '*** Inigeom ,  Y = Latitude  , der. sinusoid . ***'
 
 c  .... utilisation  de f(x,y) a tangente sinusoidale , y etant la latit. ...
@@ -267,11 +258,11 @@
       ELSE
 c
-c   ....  utilisation  de fxyhyper , f(x,y) a derivee tangente hyperbol.
+c   ....  Utilisation  de fxyhyper , f(x,y) a derivee tangente hyperbol.
 c   .....................................................................
 
-       PRINT *,'*** Inigeom , Y = Latitude  , der.tg. hyperbolique ***'
-
-       CALL fxyhyper( clat, grossismy, dzoomy, tauy, deltay  ,
-     ,               clon, grossismx, dzoomx, taux          ,
+      WRITE(6,*)'*** Inigeom , Y = Latitude  , der.tg. hyperbolique ***'
+ 
+       CALL fxyhyper( clat, grossismy, dzoomy, tauy    , 
+     ,                clon, grossismx, dzoomx, taux    ,
      , rlatu,yprimu,rlatv, yprimv,rlatu1, yprimu1,rlatu2,yprimu2  ,
      , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025 )
@@ -387,9 +378,8 @@
 c
       IF ( j. eq. jjp1 )  THEN
-
        yprp               = yprimu2(j-1)
        rlatp              = rlatu2 (j-1)
-cc       yprp             = fyprim( FLOAT(j) - 0.25 )
-cc       rlatp            = fy    ( FLOAT(j) - 0.25 )
+ccc       yprp             = fyprim( FLOAT(j) - 0.25 )
+ccc       rlatp            = fy    ( FLOAT(j) - 0.25 )
 c
       coslatp             = COS( rlatp )
@@ -425,8 +415,8 @@
         rlatm    = rlatu1 (  j  )
         yprm     = yprimu1(  j  )
-c         rlatp    = fy    ( FLOAT(j) - 0.25 )
-c         yprp     = fyprim( FLOAT(j) - 0.25 )
-c         rlatm    = fy    ( FLOAT(j) + 0.25 )
-c         yprm     = fyprim( FLOAT(j) + 0.25 )
+cc         rlatp    = fy    ( FLOAT(j) - 0.25 )
+cc         yprp     = fyprim( FLOAT(j) - 0.25 )
+cc         rlatm    = fy    ( FLOAT(j) + 0.25 )
+cc         yprm     = fyprim( FLOAT(j) + 0.25 )
 
          coslatm  = COS( rlatm )
@@ -490,5 +480,4 @@
   36  CONTINUE
 c
-c   ....  Modif  P. Le Van  ( 4/07/96 )  .....
 c
       aire    (iip1,j) = aire    (1,j)
@@ -620,5 +609,5 @@
          aiuscv2gam(iip1,j)  = aiuscv2gam(1,j)
       ENDDO
-c
+
 c
 c   calcul des aires aux  poles :
@@ -666,30 +655,43 @@
 c-----------------------------------------------------------------------
 c
-       PRINT *,' INIGEOM  RLONV '
+       WRITE(6,*) '   ***  Coordonnees de la grille  *** '
+       WRITE(6,995)
+c
+       WRITE(6,*) '   LONGITUDES  aux pts.   V  ( degres )  '
+       WRITE(6,995)
         DO i=1,iip1
          rlonvv(i) = rlonv(i)*180./pi
         ENDDO
-       PRINT 400,rlonvv
-c
-       PRINT *,' RLATV '
+       WRITE(6,400) rlonvv
+c
+       WRITE(6,995)
+       WRITE(6,*) '   LATITUDES   aux pts.   V  ( degres )  '
+       WRITE(6,995)
         DO i=1,jjm
          rlatuu(i)=rlatv(i)*180./pi
         ENDDO
-       PRINT 400,(rlatuu(i),i=1,jjm)
+       WRITE(6,400) (rlatuu(i),i=1,jjm)
 c
         DO i=1,iip1
           rlonvv(i)=rlonu(i)*180./pi
         ENDDO
-       PRINT *,' RLONU '
-       PRINT 400,rlonvv
-c
-       PRINT *,' RLATU '
+       WRITE(6,995)
+       WRITE(6,*) '   LONGITUDES  aux pts.   U  ( degres )  '
+       WRITE(6,995)
+       WRITE(6,400) rlonvv
+       WRITE(6,995)
+
+       WRITE(6,*) '   LATITUDES   aux pts.   U  ( degres )  '
+       WRITE(6,995)
         DO i=1,jjp1
          rlatuu(i)=rlatu(i)*180./pi
         ENDDO
-       PRINT 400,(rlatuu(i),i=1,jjp1)
-c
+       WRITE(6,400) (rlatuu(i),i=1,jjp1)
+       WRITE(6,995)
+c
+444    format(f10.3,f6.0)
 400    FORMAT(1x,8f8.2)
 990    FORMAT(//)
+995    FORMAT(/)
 c
       RETURN
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/integrd.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/integrd.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/integrd.F	(revision 497)
@@ -91,16 +91,14 @@
       ENDDO
 c
-      IF( alphax.NE.0. )   THEN
-        DO  ij    = 1, iim
-         tppn(ij) = aire(   ij   ) * ps(  ij    )
-         tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
-        ENDDO
-         tpn      = SSUM(iim,tppn,1)/apoln
-         tps      = SSUM(iim,tpps,1)/apols
-        DO ij   = 1, iip1
-         ps(   ij   )  = tpn
-         ps(ij+ip1jm)  = tps
-        ENDDO
-      ENDIF
+      DO  ij    = 1, iim
+       tppn(ij) = aire(   ij   ) * ps(  ij    )
+       tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
+      ENDDO
+       tpn      = SSUM(iim,tppn,1)/apoln
+       tps      = SSUM(iim,tpps,1)/apols
+      DO ij   = 1, iip1
+       ps(   ij   )  = tpn
+       ps(ij+ip1jm)  = tps
+      ENDDO
 c
 c  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
@@ -136,17 +134,15 @@
 c
 c
-      IF( alphax.NE.0. )   THEN
-        DO  ij   = 1, iim
+      DO  ij   = 1, iim
         tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
         tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
-        ENDDO
+      ENDDO
         tpn      = SSUM(iim,tppn,1)/apoln
         tps      = SSUM(iim,tpps,1)/apols
 
-        DO ij   = 1, iip1
+      DO ij   = 1, iip1
         teta(   ij   ,l)  = tpn
         teta(ij+ip1jm,l)  = tps
-        ENDDO
-      ENDIF
+      ENDDO
 c
 
@@ -197,25 +193,23 @@
 c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
 c
-      IF( alphax.NE.0. )   THEN
-
-        DO iq = 1, nq
-          DO l = 1, llm
-
-             DO ij = 1, iim
+
+      DO iq = 1, nq
+        DO l = 1, llm
+
+           DO ij = 1, iim
              qppn(ij) = aire(   ij   ) * q(   ij   ,l,iq)
              qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
-             ENDDO
+           ENDDO
              qpn  =  SSUM(iim,qppn,1)/apoln
              qps  =  SSUM(iim,qpps,1)/apols
 
-             DO ij = 1, iip1
+           DO ij = 1, iip1
              q(   ij   ,l,iq)  = qpn
              q(ij+ip1jm,l,iq)  = qps
-             ENDDO
-
-          ENDDO
-        ENDDO
-
-      ENDIF
+           ENDDO
+
+        ENDDO
+      ENDDO
+
 
          CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_barx.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_barx.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_barx.F	(revision 497)
@@ -0,0 +1,215 @@
+       SUBROUTINE inter_barx ( idatmax,xidat,fdat,imodmax,ximod,fmod ) 
+
+c      .... Auteurs :  Robert Sadourny ,  P. Le Van  .....
+c
+       IMPLICIT NONE
+c    ----------------------------------------------------------
+c        INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
+c            VERSION UNIDIMENSIONNELLE  ,   EN  LONGITUDE .
+c    ----------------------------------------------------------
+c
+c     idat : indice du champ de donnees, de 1 a idatmax
+c     imod : indice du champ du modele,  de 1 a  imodmax
+c     fdat(idat) : champ de donnees (entrees)
+c     fmod(imod) : champ du modele (sorties)
+c     xidat(idat): abscisses des interfaces des mailles donnees
+c     ximod(imod): abscisses des interfaces des mailles modele
+c      ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)
+c      ( Les abscisses sont exprimes en degres)
+
+
+      INTEGER idatmax, imodmax
+      REAL xidat(idatmax),fdat(idatmax),ximod(imodmax),fmod(imodmax)
+
+c    ...  Variables locales ... 
+    
+      REAL xxid(idatmax+1), xxd(idatmax+1), fdd(idatmax+1)
+      REAL  fxd(idatmax+1), xchan(idatmax+1), fdchan(idatmax+1) 
+      REAL  xxim(imodmax)
+
+      REAL x0,xim0,dx,dxm
+      REAL chmin,chmax,pi
+
+      INTEGER imod,idat,i,ichang,id0,id1,nid,idatmax1
+      
+      pi = 2. * ASIN(1.)
+
+c  -----------------------------------------------------
+c   REDEFINITION DE L'ORIGINE DES ABSCISSES
+c    A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE  
+c  -----------------------------------------------------
+      DO imod = 1,imodmax
+       xxim(imod) = ximod(imod)
+      ENDDO
+
+      CALL minmax( imodmax,xxim,chmin,chmax)
+       IF( chmax.LT.6.50 )   THEN
+c        PRINT  3
+c        PRINT *,'   conversion des longit. ximod (donnees en radians)'
+c     , ,' en degres  .' 
+c        PRINT  3
+        DO imod = 1, imodmax
+        xxim(imod) = xxim(imod) * 180./pi
+        ENDDO  
+       ENDIF
+
+      xim0 = xxim(imodmax) - 360.
+
+      DO imod = 1, imodmax
+       xxim(imod) = xxim(imod) - xim0
+      ENDDO
+
+      idatmax1 = idatmax +1
+
+      DO idat = 1, idatmax
+       xxd(idat) = xidat(idat)
+      ENDDO
+
+      CALL minmax( idatmax,xxd,chmin,chmax)
+       IF( chmax.LT.6.50 )  THEN
+c        PRINT  3
+c        PRINT *,'   conversion des longit. ximod (donnees en radians)'
+c     , ,' en degres  .' 
+c        PRINT  3
+        DO idat = 1, idatmax
+        xxd(idat) = xxd(idat) * 180./pi
+        ENDDO  
+       ENDIF
+
+      DO idat = 1, idatmax
+       xxd(idat) = AMOD( xxd(idat) - xim0, 360. )
+       fdd(idat) = fdat (idat)
+      ENDDO
+c       PRINT *,' xxd redef. origine abscisses '
+c       PRINT 2,(xxd(i),i=1,idatmax)
+
+      DO i = 2, idatmax
+        IF( ( xxd(i) - xxd(i-1)).LT.0. )  THEN
+         ichang = i
+         GO TO 5
+        ENDIF
+      ENDDO
+      GO TO 6
+c
+c  ***  reorganisation  des longitudes entre 0. et 360. degres ****
+c
+ 5    nid = idatmax - ichang +1
+      DO i = 1, nid
+        xchan (i) = xxd(i+ichang -1 )
+        fdchan(i) = fdd(i+ichang -1 )
+      ENDDO
+       DO i=1,ichang -1
+        xchan (i+ nid) = xxd(i)
+        fdchan(i+nid) = fdd(i) 
+       ENDDO
+      DO i =1,idatmax
+       xxd(i) = xchan(i)
+       fdd(i) = fdchan(i)
+      ENDDO
+
+ 6    continue
+
+
+c  ------------------------------------------------
+c    translation des champs de donnees par rapport
+c    a la nouvelle origine, avec redondance de la
+c       maille a cheval sur les bords
+c -----------------------------------------------
+
+      id0 = 0
+      id1 = 0
+
+      DO idat = 1, idatmax
+       IF ( xxd( idatmax1- idat ).LT.360.)   GO TO 10
+       id1 = id1 + 1
+      ENDDO
+
+ 10   DO idat = 1, idatmax
+       IF (xxd(idat).GT.0.) GO TO 20
+       id0 = id0 + 1
+      END DO
+
+ 20   IF( id1.EQ.0 ) GO TO 30
+      DO idat = 1, id1
+       xxid(idat) = xxd(idatmax - id1 + idat) - 360.
+       fxd (idat) = fdd(idatmax - id1 + idat)     
+      END DO
+      DO idat = 1, idatmax - id1
+       xxid(idat + id1) = xxd(idat)
+       fxd (idat + id1) = fdd(idat)
+      END DO
+
+  30  IF(id0.EQ.0) GO TO 40
+      DO idat = 1, idatmax - id0
+       xxid(idat) = xxd(idat + id0)
+       fxd (idat) = fdd(idat + id0)
+      END DO
+
+      DO idat = 1, id0
+       xxid (idatmax - id0 + idat) =  xxd(idat) + 360.
+       fxd  (idatmax - id0 + idat) =  fdd(idat)   
+      END DO
+      GO TO 50
+ 
+ 40   DO idat = 1, idatmax
+       xxid(idat)  = xxd(idat)
+       fxd (idat)  = fdd(idat)
+      ENDDO
+
+ 50   xxid(idatmax1) = xxid(1) + 360.
+      fxd (idatmax1) = fxd(1)
+
+c  ------------------------------------
+c   initialisation du champ du modele
+
+      DO imod = 1, imodmax
+       fmod(imod) = 0.
+      END DO
+ 
+c      PRINT *,' id0 id1 ',id0,id1
+c      PRINT *,' xxim apres translation  '
+c      PRINT 2,(xxim(i),i=1,imodmax)
+c      PRINT *,' xxid apres translation '
+c      PRINT 2,(xxid(i),i=1,idatmax)
+c ---------------------------------------
+c iteration
+
+      x0   = xim0
+      dxm  = 0.
+      imod = 1
+      idat = 1
+ 
+ 100  IF (xxim(imod).LT.xxid(idat)) THEN
+       dx   = xxim(imod) - x0
+       dxm  = dxm + dx
+       fmod(imod) = (fmod(imod) + dx * fxd(idat)) / dxm
+       x0   = xxim(imod)
+       dxm  = 0.
+       imod = imod + 1
+       IF (imod.LE.imodmax) GO TO 100
+  
+      ELSE IF (xxim(imod).GT.xxid(idat)) THEN
+       dx   = xxid(idat) - x0
+       dxm  = dxm + dx
+       fmod(imod) = fmod(imod) + dx * fxd(idat)
+       x0   = xxid(idat)
+       idat = idat + 1
+       GO TO 100
+ 
+      ELSE
+       dx   = xxim(imod) - x0
+       dxm  = dxm + dx
+       fmod(imod) = (fmod(imod) + dx * fxd(idat)) / dxm
+       x0   = xxim(imod)
+       dxm  = 0.
+       imod = imod + 1
+       idat = idat + 1
+       IF (imod.LE.imodmax) GO TO 100
+      END IF
+     
+
+3      FORMAT(1x,70(1h-))
+2      FORMAT(1x,8f8.2)
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_barxy.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_barxy.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_barxy.F	(revision 497)
@@ -0,0 +1,56 @@
+       SUBROUTINE inter_barxy ( interfd,jnterfd,dlonid,dlatid ,
+     ,        champ,imod,jmod,rlonimod,rlatimod, jsort,champint )
+
+c    Auteur :   P. Le Van
+c
+       INTEGER interfd,jnterfd,imod,jmod
+       REAL champ(interfd,jnterfd +1 ),dlonid(interfd),dlatid(jnterfd),
+     ,      champint(imod,jsort)
+       REAL rlonimod(imod),rlatimod(jmod)
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+
+       REAL champx(imod),champy(jnterfd +1,imod),chpn(imod),chps(imod)
+       REAL chhpn,chhps
+       REAL fmody(jjp1)
+c
+
+       DO j = 1, jnterfd + 1
+        CALL inter_barx( interfd, dlonid, champ( 1,j ),
+     ,                       imod, rlonimod , champx )
+         DO i = 1,imod
+           champy(j,i) = champx(i)
+         ENDDO
+       ENDDO
+
+       DO i = 1, imod
+        CALL inter_bary( jjm,jnterfd,dlatid,champy(1,i),
+     ,                     jmod ,rlatimod,  fmody     )
+          DO j = 1, jsort
+           champint(i,j) = fmody(j)
+          ENDDO
+       ENDDO
+
+       IF( jsort.EQ.jjp1)  THEN
+
+c   ....  Valeurs uniques  aux  poles ....
+c
+         DO i =  1,imod
+          chpn(i)  = aire( i,  1   ) * champint( i, 1   )
+          chps(i)  = aire( i, jjp1 ) * champint( i,jjp1 )
+         ENDDO
+          chhpn  = SSUM(imod,chpn,1)/apoln
+          chhps  = SSUM(imod,chps,1)/apols
+
+         DO i = 1, imod
+          champint( i,  1  ) = chhpn
+          champint( i, jjp1) = chhps
+         ENDDO
+c
+       ENDIF
+
+       RETURN
+       END
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_bary.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_bary.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/inter_bary.F	(revision 497)
@@ -0,0 +1,132 @@
+       SUBROUTINE inter_bary( jjm, jdatmax, yjdatt, fdatt  ,
+     ,                       jmodmax, yjmodd,  fmod      )
+c
+c    ...  Auteurs :  Robert Sadourny  , P. Le Van ...
+c
+       IMPLICIT NONE
+
+c  ----------------------------------------------------------
+c       INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES  .
+c         VERSION UNIDIMENSIONNELLE  ,    EN LATITUDE  .
+c  ----------------------------------------------------------
+c
+c     jdat : indice du champ de donnees, de 1 a jdatmax
+c     jmod : indice du champ du modele,  de 1 a jmodmax
+c     fdatt(jdatmax) : champ de donnees (entrees)
+c     yjdatt(jdatmax): ordonnees des interfaces des mailles donnees
+c     yjmodd(jmodmax): ordonnees des interfaces des mailles modele
+c     fmod(jmodmax)  : champ du modele  (sorties)
+c
+c      ( L'indice 1 correspond a l'interface maille 1 / maille 2)
+c      ( Les ordonnees sont exprimees en degres)
+c
+c     jdatmax = nb. d'interfaces  donnees =  nombre de donnees - 1 
+c     jmodmax = nb. d'interfaces  modele
+
+c     Si jmodmax = jjm , on veut interpoler sur les jjm+1 latitudes 
+c       rlatu   du modele ( lat.  des scalaires et de U ) 
+c
+c     Si jmodmax = jjp1 , on veut interpoler sur les jjm latitudes 
+c       rlatv du modele  ( lat.  de  V ) 
+
+c  ....  Arguments  en entree  .......
+
+       INTEGER jjm , jdatmax, jmodmax
+       REAL    yjdatt( jdatmax ) , fdatt( jdatmax +1 )
+       REAL    yjmodd( jmodmax )     
+
+c  ....  Arguments  en sortie  .......
+c
+       REAL    fmod( jmodmax + 1 )
+c
+c   ...... Variables locales  ......
+
+       INTEGER      jmods
+
+       REAL       yjdat ( jdatmax +1 ), fdat( jdatmax +1) 
+       REAL       fscrat( jdatmax +1 )
+       REAL       yjmod ( jmodmax +1 )
+       LOGICAL    decrois
+       SAVE       decrois
+c
+       REAL y0,dy,dym 
+       INTEGER jdat, jmod,i
+c
+
+        DO i = 1, jdatmax +1
+         fdat (i) = fdatt (i)
+        ENDDO
+
+       CALL ord_coord (  jdatmax , yjdatt(1), yjdat(1), decrois ) 
+
+       IF( decrois )   THEN
+         DO i = 1,jdatmax + 1
+          fscrat(i) = fdat(i)
+         ENDDO
+         DO i = 1, jdatmax + 1
+          fdat(i) = fscrat( jdatmax + 2 -i )
+         ENDDO
+
+       ENDIF
+
+       CALL ord_coordm (jmodmax,yjmodd(1),yjmod(1),jjm,jmods,decrois ) 
+c
+c      Initialisation des variables
+c    --------------------------------
+
+       DO jmod = 1, jmods
+        fmod(jmod) = 0.
+       END DO
+
+       y0    = 0.
+       dym   = 0.
+       jmod  = 1
+       jdat  = 1
+c  --------------------
+c      Iteration
+c  --------------------
+
+100    IF ( yjmod(jmod).LT.yjdat(jdat) ) THEN
+        dy         = yjmod(jmod) - y0
+        dym        = dym + dy
+        fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym
+        y0         = yjmod(jmod)
+        dym        = 0.
+        jmod       = jmod + 1
+        GO TO 100
+
+       ELSE IF ( yjmod(jmod).GT.yjdat(jdat) ) THEN
+        dy         = yjdat(jdat) - y0
+        dym        = dym + dy
+        fmod(jmod) = fmod(jmod) + dy * fdat(jdat)
+        y0         = yjdat(jdat)
+        jdat       = jdat + 1
+
+       GO TO 100
+
+       ELSE
+        dy         = yjmod(jmod) - y0
+        dym        = dym + dy
+        fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym
+        y0         = yjmod(jmod)
+        dym        = 0.
+        jmod       = jmod + 1
+        jdat       = jdat + 1
+
+        IF ( jmod.LE.jmods ) GO TO 100
+       END IF
+c   ---------------------------------------------
+c    Le test de fin suppose que l'interface 0
+c    est commune aux deux grilles yjdat et yjmod.
+c   ----------------------------------------------
+       IF( decrois )  THEN
+         DO i = 1,jmods
+          fscrat(i) = fmod(i)
+         ENDDO
+         DO i = 1, jmods
+          fmod(i) = fscrat( jmods + 1 -i )
+         ENDDO
+       ENDIF
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/lectflux.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/lectflux.F	(revision 3)
+++ 	(revision )
@@ -1,233 +1,0 @@
-      SUBROUTINE lectflux(irec,massem,pbarun,pbarvn,wn,tetan,phin,
-     s     nrec,avant,airefi,
-     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
-     s     yu1,yv1,ftsol,pctsrf,
-     s     frac_impa,frac_nucl,phis)
-
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom2.h"
-
-#include "tracstoke.h"
-
-      integer irec,nrec,i,j
-
-      integer ngridmx,ig,l
-      parameter (ngridmx=iim*(jjm-1)+2)
-      INTEGER nbsrf
-      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
-
-      real zmfd(ngridmx,llm),zde_d(ngridmx,llm),zen_d(ngridmx,llm)
-      real zmfu(ngridmx,llm),zde_u(ngridmx,llm),zen_u(ngridmx,llm)
-      real coefkz(ngridmx,llm)
-      real frac_impa(ngridmx,llm),frac_nucl(ngridmx,llm)
-      real yu1(ngridmx), yv1(ngridmx)
-      real ftsol(ngridmx,nbsrf),pctsrf(ngridmx,nbsrf)
-      integer imfu,imfd,ien_u,ide_u,
-     s      ien_d,ide_d,
-     s      icoefkz,izu1,izv1,
-     s      itsol,ipsf,
-     s      ilei, ilec
-      parameter(imfu=1,imfd=llm+1,ien_u=2*llm+1,ide_u=3*llm+1,
-     s      ien_d=4*llm+1,ide_d=5*llm+1,
-     s      icoefkz=6*llm+1,
-     s      ilei=7*llm+1,ilec=8*llm+1,
-     s      izu1=9*llm+1,izv1=9*llm+2,
-     s      itsol=9*llm+3,ipsf=9*llm+3+nbsrf)
-      logical avant
-
-      real massefi(ngridmx,llm)
-
-      real massem(ip1jmp1,llm),tetan(ip1jmp1,llm)
-      real pbarun(iip1,jjp1,llm),pbarvn(iip1,jjm,llm)
-      real pbarvst(iip1,jjp1,llm)
-      real wn(iip1,jjp1,llm),phin(iip1,jjp1,llm)
-      real phis(iip1,jjp1)
-
-      real airefi(ngridmx)
-
-      real xlecn(ngridmx,9*llm+2+2*nbsrf)
-
-      real zcontrole(ngridmx),zmass,tmpdyn(iip1,jjp1),zflux
-
-      real ziadvtrac,zrec,ziadvtrac2,zrec2
-      real zim,zjm,zlm,zklon,zklev
-
-      real zpi
-
-      zpi=2.*asin(1.)
-
-
-c==================================================================
-c   Si le numero du record est 0 alors: INITIALISATION
-c==================================================================
-c
-      print*,'ENTREE DANS LECTFLUX'
-        print*,'IREC=',IREC
-      if(irec.eq.0) then
-
-        print*,'IREC==',0
-
-C test         call inigeom
-
-c==================================================================
-c   ouverture des fichiers
-c==================================================================
-
-c   Fichier fluxmass
-#ifdef CRAY
-         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
-#endif
-      open(47,file='fluxmass',form='unformatted',
-     s     access='direct'
-     s     ,recl=4*(6*ijp1llm))
-      read(47,rec=1) zrec,dtvr,ziadvtrac,zim,zjm,zlm,
-     s   rlonu,rlonv,rlatu,rlatv,aire
-     s    ,phis
-      print*,'zrec,dtvr,ziadvtrac,zim,zjm,zlm'
-      print*,zrec,dtvr,ziadvtrac,zim,zjm,zlm
-      print*,rlonv
-
-
-
-c  Fichier physique
-c  Fichier lessivage (supprime les donnees utiles sont dans "physique")
-#ifdef CRAY
-         CALL ASSIGN("assign -N ieee -F null f:physique")
-#endif
-      open(49,file='physique',form='unformatted',
-     s     access='direct'
-     s     ,recl=4*ngridmx*(9*llm+2+2*nbsrf))
-      read(49,rec=1) zrec2,ziadvtrac2,zklon,zklev
-      print*,'Entete du fichier physique'
-      print*,zrec2,ziadvtrac2,zklon,zklev
-
-      nrec=zrec
-      print*,'nrec=',nrec
-
-      istdyn=ziadvtrac
-      istphy=ziadvtrac2
-
-c==================================================================
-c   Fin des initialisations
-      else ! irec=0
-c==================================================================
-
-
-c-----------------------------------------------------------------------
-c   Lecture des fichiers fluxmass et  physique:
-c   -----------------------------------------------------
-
-c  Variables dynamiques
-         read(47,rec=irec) massem,pbarun,pbarvst,wn,tetan,phin
-        do l=1,llm
-           do j=1,jjm
-              do i=1,iip1
-                 pbarvn(i,j,l)=pbarvst(i,j,l)
-              enddo
-           enddo
-        enddo
-
-c  Variables physiques
-         read(49,rec=irec) ((xlecn(ig,l),ig=1,ngridmx),
-     s                                    l=1,9*llm+2+2*nbsrf)
-
-       do l=1,llm
-          do ig=1,ngridmx
-             coefkz(ig,l)=xlecn(ig,icoefkz+l-1)
-             frac_impa(ig,l)=xlecn(ig,ilei+l-1)
-             frac_nucl(ig,l)=xlecn(ig,ilec+l-1)
-          enddo
-       enddo
-       do l=1,nbsrf
-          do ig=1,ngridmx
-             ftsol(ig,l)=xlecn(ig,itsol+l-1)
-             pctsrf(ig,l)=xlecn(ig,ipsf+l-1)
-          enddo
-       enddo
-       do ig=1,ngridmx
-          yv1(ig)=xlecn(ig,izv1)
-          yu1(ig)=xlecn(ig,izu1)
-       enddo
-C
-      if(avant) then
-c   Simu directe
-       do l=1,llm
-          do ig=1,ngridmx
-             zmfu(ig,l)=xlecn(ig,imfu+l-1)
-             zmfd(ig,l)=xlecn(ig,imfd+l-1)
-             zde_u(ig,l)=xlecn(ig,ide_u+l-1)
-             zen_u(ig,l)=xlecn(ig,ien_u+l-1)
-             zde_d(ig,l)=xlecn(ig,ide_d+l-1)
-             zen_d(ig,l)=xlecn(ig,ien_d+l-1)
-          enddo
-       enddo
-      else
-c   Simu retro
-       do l=1,llm
-          do ig=1,ngridmx
-             zmfd(ig,l)=-xlecn(ig,imfu+l-1)
-             zmfu(ig,l)=-xlecn(ig,imfd+l-1)
-             zen_d(ig,l)=xlecn(ig,ide_u+l-1)
-             zde_d(ig,l)=xlecn(ig,ien_u+l-1)
-             zen_u(ig,l)=xlecn(ig,ide_d+l-1)
-             zde_u(ig,l)=xlecn(ig,ien_d+l-1)
-          enddo
-       enddo
-      endif
-
-c-----------------------------------------------------------------------
-c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
-c-----------------------------------------------------------------------
-
-      print*,'Ap redec irec'
-
-         call gr_dyn_fi(llm,iip1,jjp1,ngridmx,massem,massefi)
-
-         do ig=1,ngridmx
-            zcontrole(ig)=1.
-         enddo
-c   zmass=(max(massem(ig,l),massem(ig,l-1))/airefi(ig)
-         do l=2,llm
-            do ig=1,ngridmx
-               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
-               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
-               if(zflux.gt.0.9*zmass) then
-                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
-               endif
-            enddo
-         enddo
-
-         do ig=1,ngridmx
-            if(zcontrole(ig).lt.0.99999) then
-               print*,'ATTENTION !!! on reduit les flux de masse '
-               print*,'convectifs au point ig=',ig
-            endif
-         enddo
-
-         call gr_fi_dyn(1,ngridmx,iip1,jjp1,zcontrole,tmpdyn)
-
-         do l=1,llm
-            do ig=1,ngridmx
-               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
-               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
-               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
-               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
-               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
-               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
-            enddo
-         enddo
-
-
-      endif ! irec=0
-
-
-      RETURN
-      END
-
-
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/lectfluxnc.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/lectfluxnc.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/lectfluxnc.F	(revision 497)
@@ -0,0 +1,218 @@
+c
+c $Header$
+c
+      SUBROUTINE lectfluxnc(irec,massem,pbarun,pbarvn,wn,tetan,phin,
+     s     nrec,avant,airefi,phisfi,
+     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf,
+     s     frac_impa,frac_nucl,phis)
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom2.h"
+
+#include "tracstoke.h"
+
+      integer irec,nrec,i,j
+
+      integer klon,ig,l
+      parameter (klon=iim*(jjm-1)+2)
+      INTEGER nbsrf
+      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
+
+c Convection
+      real*4 zmfd(klon,llm),zde_d(klon,llm),zen_d(klon,llm)
+      real*4 zmfu(klon,llm),zde_u(klon,llm),zen_u(klon,llm)
+      real*4 mfd(klon,llm),de_d(klon,llm),en_d(klon,llm)
+      real*4 mfu(klon,llm),de_u(klon,llm),en_u(klon,llm)
+	real*4 t(klon,llm)
+      real zdtvr
+	
+	real*4 airedy(iip1,jjp1)
+      real*4 rlonu_dy(iip1,jjp1),rlonv_dy(iip1,jjm),
+     . rlatu_dy(iip1,jjp1),rlatv_dy(iip1,jjm)
+
+      real*4 coefkz(klon,llm)
+      real*4 frac_impa(klon,llm),frac_nucl(klon,llm)
+      real*4 yu1(klon), yv1(klon)
+      real*4 ftsol(klon,nbsrf),pctsrf(klon,nbsrf)
+
+      logical avant
+
+      real massefi(klon,llm)
+
+c   Flux masse
+      real*4 massem(iip1,jjp1,llm),tetan(iip1,jjp1,llm)
+      real*4 pbarun(iip1,jjp1,llm),pbarvn(iip1,jjm,llm)
+      real*4 pbarvst(iip1,jjp1,llm)
+      real*4 wn(iip1,jjp1,llm),phin(iip1,jjp1,llm)
+      real*4 phis(iip1,jjp1)
+
+      real*4 airefi(klon),phisfi(klon)
+
+      real zcontrole(klon),zmass,tmpdyn(iip1,jjp1),zflux
+
+      real ziadvtrac,ziadvtrac2,zrec2
+      integer zim,zjm,zlm,zklon,zklev,zrec
+
+      real zpi
+
+      zpi=2.*asin(1.)
+
+
+c==================================================================
+c   Si le numero du record est 0 alors: INITIALISATION
+c==================================================================
+c
+      print*,'ENTREE DANS LECTFLUXNC'
+        print*,'IREC=',IREC
+
+      if(irec.eq.0) then
+
+        print*,'IREC==',0
+
+C test         call inigeom
+
+c==================================================================
+c   ouverture des fichiers
+c==================================================================
+	
+	CALL read_dstoke(0,zdtvr,ziadvtrac,ziadvtrac2)
+	
+	CALL read_fstoke0(0,
+     .  zrec,zim,zjm,zlm,
+     .   rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,airedy,phis,
+     .   massem,pbarun,pbarvn,wn,tetan,phin)
+c 
+	if(physic)then	
+	CALL read_pstoke0(0,
+     .   zrec,zklon,zklev,airefi,phisfi,
+     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefkz,
+     .   frac_impa,frac_nucl,yu1,yv1,ftsol,pctsrf)
+	endif
+	
+	dtvr=zdtvr	
+	nrec=zrec
+        print*,'nrec=',nrec
+	
+	print*, 'Lecture de defstoke.nc'
+	print*, 'Ds lectfluxnc dtvr = ', dtvr
+	print*, 'Ds lectfluxnc istdyn= ',ziadvtrac
+        print*, 'Ds lectfluxnc istphy= ',ziadvtrac2
+
+      istdyn=ziadvtrac
+      istphy=ziadvtrac2
+	
+c	pause
+
+c==================================================================
+c   Fin des initialisations
+      else ! irec=0
+c==================================================================
+
+
+c-----------------------------------------------------------------------
+c   Lecture des fichiers fluxmass et  physique:
+c   -----------------------------------------------------
+
+	 CALL read_fstoke0(irec,
+     .   zrec,zim,zjm,zlm,
+     .   rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,airedy,phis,
+     .   massem,pbarun,pbarvn,wn,tetan,phin)
+	
+	write(*,*) 'lectfluxnc aps read_fstoke irec',irec
+	if(physic)then
+        CALL read_pstoke0(irec,
+     .   zrec,zklon,zklev,airefi,phisfi,
+     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefkz,
+     .   frac_impa,frac_nucl,yu1,yv1,ftsol,pctsrf)
+	
+	write(*,*) 'lectfluxnc aps read_pstoke irec',irec
+	
+	if (avant) then
+c Simu directe
+       do l=1,llm
+          do ig=1,klon
+             zmfu(ig,l)=mfu(ig,l)
+             zmfd(ig,l)=mfd(ig,l)
+             zde_u(ig,l)=de_u(ig,l)
+             zen_u(ig,l)=en_u(ig,l)
+             zde_d(ig,l)=de_d(ig,l)
+             zen_d(ig,l)=en_d(ig,l)
+          enddo
+       enddo
+      else
+c   Simu retro
+       do l=1,llm
+          do ig=1,klon
+             zmfd(ig,l)=-mfu(ig,l)
+             zmfu(ig,l)=-mfd(ig,l)
+             zen_d(ig,l)=de_u(ig,l)
+             zde_d(ig,l)=en_u(ig,l)
+             zen_u(ig,l)=de_d(ig,l)
+             zde_u(ig,l)=en_d(ig,l)
+          enddo
+       enddo
+      endif
+
+c-----------------------------------------------------------------------
+c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
+c-----------------------------------------------------------------------
+
+      print*,'Ap redec irec'
+	write(*,*) 'dtphys = ', dtphys
+
+         call gr_dyn_fi(llm,iip1,jjp1,klon,massem,massefi)
+
+         do ig=1,klon
+            zcontrole(ig)=1.
+         enddo
+c   zmass=(max(massem(ig,l),massem(ig,l-1))/airefi(ig)
+         do l=2,llm
+            do ig=1,klon
+               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
+               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
+               if(zflux.gt.0.9*zmass) then
+                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
+               endif
+            enddo
+         enddo
+
+         do ig=1,klon
+            if(zcontrole(ig).lt.0.99999) then
+               print*,'ATTENTION !!! on reduit les flux de masse '
+               print*,'convectifs au point ig=',ig
+            endif
+         enddo
+	
+	write(*,*) 'lectfluxnc avt gr_fi_dyn'
+
+         call gr_fi_dyn(1,klon,iip1,jjp1,zcontrole,tmpdyn)
+	
+	write(*,*) 'lectfluxnc aps gr_fi_dyn'
+        
+         do l=1,llm
+            do ig=1,klon
+               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
+               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
+               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
+               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
+               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
+               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
+            enddo
+         enddo
+	 endif
+	
+	write(*,*) 'lectfluxnc fin de boucle if'
+
+      endif ! irec=0
+
+      RETURN
+      END
+
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/limit_netcdf.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/limit_netcdf.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/limit_netcdf.F	(revision 497)
@@ -0,0 +1,1290 @@
+C
+C $Header$
+C
+      SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque, pctsrf)
+c
+      IMPLICIT none
+c
+c-------------------------------------------------------------
+C Author : L. Fairhead
+C Date   : 27/01/94
+C Objet  : Construction des fichiers de conditions aux limites
+C          pour le nouveau
+C          modele a partir de fichiers de climatologie. Les deux
+C          grilles doivent etre regulieres
+c
+c Modifie par z.x.li (le23mars1994)
+c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
+c                         pour lecture netcdf dans LMDZ.3.3
+c Modifie par P;Le Van  ,  juillet 2001
+c-------------------------------------------------------------
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "control.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "comconst.h"
+#include "dimphy.h"
+#include "indicesol.h"
+c
+c-----------------------------------------------------------------------
+      LOGICAL interbar, extrap, oldice
+
+      REAL phy_nat(klon,360), phy_nat0(klon)
+      REAL phy_alb(klon,360)
+      REAL phy_sst(klon,360)
+      REAL phy_bil(klon,360)
+      REAL phy_rug(klon,360)
+      REAL phy_ice(klon)
+c
+      real pctsrf_t(klon,nbsrf,360)
+      real pctsrf(klon,nbsrf)
+      REAL verif
+
+      REAL masque(iip1,jjp1)
+      REAL mask(iim,jjp1)
+CPB
+C newlmt indique l'utilisation de la sous-maille fractionnelle
+C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
+      LOGICAL newlmt, fracterre
+      PARAMETER(newlmt=.TRUE.)
+      PARAMETER(fracterre = .TRUE.) 
+
+C Declarations pour le champ de depart
+      INTEGER imdep, jmdep,lmdep
+      INTEGER  tbid
+      PARAMETER ( tbid = 60 )        ! >52 semaines
+      REAL  timecoord(tbid)
+c
+      REAL , ALLOCATABLE :: dlon_msk(:), dlat_msk(:)
+      REAL , ALLOCATABLE :: lonmsk_ini(:), latmsk_ini(:)
+      REAL , ALLOCATABLE :: dlon(:), dlat(:)
+      REAL , ALLOCATABLE :: dlon_ini(:), dlat_ini(:)
+      REAL , ALLOCATABLE :: champ_msk(:), champ(:)
+      REAL , ALLOCATABLE :: work(:,:)
+
+      CHARACTER*25 title
+
+C Declarations pour le champ interpole 2D
+      REAL champint(iim,jjp1)
+      real chmin,chmax
+
+C Declarations pour le champ interpole 3D
+      REAL champtime(iim,jjp1,tbid)
+      REAL timeyear(tbid)
+      REAL champan(iip1,jjp1,366)
+
+C Declarations pour l'inteprolation verticale
+      REAL ax(tbid), ay(tbid)
+      REAL by
+      REAL yder(tbid)
+
+
+      INTEGER ierr
+      INTEGER dimfirst(3)
+      INTEGER dimlast(3)
+c
+      INTEGER nid, ndim, ntim
+      INTEGER dims(2), debut(2), epais(2)
+      INTEGER id_tim
+      INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
+CPB
+      INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
+
+      INTEGER i, j, k, l, ji
+c declarations pour lecture glace de mer
+      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
+      INTEGER :: itaul(1), fid
+      REAL :: lev(1), date, dt
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
+      REAL :: flic_tmp(iip1, jjp1)
+
+c Diverses variables locales
+      REAL time
+! pour la lecture du fichier masque ocean
+      integer :: nid_o2a
+      logical :: couple = .false.
+      INTEGER :: iml_omask, jml_omask
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
+      real, dimension(klon) :: ocemask_fi
+
+      INTEGER          longcles
+      PARAMETER      ( longcles = 20 )
+      REAL  clesphy0 ( longcles      )
+#include "serre.h"
+      INTEGER ncid,varid,ndimid(4),dimid
+      character*30 namedim
+      CHARACTER*80 :: varname
+
+cIM28/02/2002 <== PM
+      REAL tmidmonth(12)
+      SAVE tmidmonth
+      DATA tmidmonth/15,45,75,105,135,165,195,225,255,285,315,345/
+
+c initialisations:
+      CALL conf_gcm( 99, .TRUE. , clesphy0 )
+
+
+      pi     = 4. * ATAN(1.)
+      rad    = 6 371 229.
+      omeg   = 4.* ASIN(1.)/(24.*3600.)
+      g      = 9.8
+      daysec = 86400.
+      kappa  = 0.2857143
+      cpp    = 1004.70885
+      dtvr    = daysec/FLOAT(day_step)
+      CALL inigeom
+c
+C Traitement du relief au sol
+c
+      write(*,*) 'Traitement du relief au sol pour fabriquer masque'
+      ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
+
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+
+      ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      print*,'variable ', namedim, 'dimension ', imdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+
+      ALLOCATE( lonmsk_ini(imdep) )
+      ALLOCATE(   dlon_msk(imdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,lonmsk_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,lonmsk_ini)
+#endif
+
+c
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      print*,'variable ', namedim, 'dimension ', jmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+
+      ALLOCATE( latmsk_ini(jmdep) )
+      ALLOCATE(   dlat_msk(jmdep) )
+      ALLOCATE(  champ_msk(imdep*jmdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,latmsk_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,latmsk_ini)
+#endif
+c
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
+#endif
+c
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+c
+      title='RELIEF'
+
+      CALL conf_dat2d(title,imdep, jmdep, lonmsk_ini, latmsk_ini,
+     . dlon_msk, dlat_msk, champ_msk, interbar  )
+
+      DO i = 1, iim
+      DO j = 1, jjp1
+         mask(i,j) = masque(i,j)
+      ENDDO
+      ENDDO
+      WRITE(*,*) 'MASK:'
+      WRITE(*,'(96i1)')INT(mask)     
+      ierr = NF_CLOSE(ncid)
+c
+c
+C Traitement de la rugosite
+c
+      PRINT*, 'Traitement de la rugosite'
+      ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+
+      ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', imdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE( dlon_ini(imdep) )
+      ALLOCATE(     dlon(imdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', jmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE( dlat_ini(jmdep) )
+      ALLOCATE(     dlat(jmdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      print*,'variable ', namedim, 'dimension ', lmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+c
+      ALLOCATE( champ(imdep*jmdep) )
+
+      DO  200 l = 1, lmdep
+         dimfirst(1) = 1
+         dimfirst(2) = 1
+         dimfirst(3) = l
+c
+         dimlast(1) = imdep
+         dimlast(2) = jmdep
+         dimlast(3) = 1
+c
+         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+         print*,dimfirst,dimlast
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
+         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
+         if (ierr.ne.0) then
+           print *, NF_STRERROR(ierr)
+           STOP
+         ENDIF 
+   
+        title = 'Rugosite Amip '
+c
+        CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
+     .                      dlon, dlat, champ, interbar          )
+
+       IF ( interbar )   THEN
+         DO j = 1, imdep * jmdep
+           champ(j) = LOG(champ(j))
+         ENDDO
+
+        IF( l.EQ.1 )  THEN
+         WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour la rugosite $$$ '
+         WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+        ENDIF
+        CALL inter_barxy ( imdep,jmdep -1,dlon,dlat,champ ,
+     ,                  iim,jjm,rlonu,rlatv, jjp1,champint )
+         DO j=1,jjp1
+          DO i=1,iim
+           champint(i,j)=EXP(champint(i,j))
+          ENDDO
+         ENDDO
+
+         DO j = 1, jjp1
+           DO i = 1, iim
+             IF(NINT(mask(i,j)).NE.1)  THEN
+               champint( i,j ) = 0.001
+             ENDIF
+           ENDDO
+         ENDDO
+      ELSE
+         CALL rugosite(imdep, jmdep, dlon, dlat, champ,
+     .             iim, jjp1, rlonv, rlatu, champint, mask)
+      ENDIF
+         DO j = 1,jjp1
+         DO i = 1, iim
+            champtime (i,j,l) = champint(i,j)
+         ENDDO
+         ENDDO
+200      CONTINUE
+c
+      DO l = 1, lmdep
+         timeyear(l) = timecoord(l)
+      ENDDO
+
+      PRINT 222, timeyear
+222   FORMAT(2x,' Time year ',10f6.1)
+c
+        
+      PRINT*, 'Interpolation temporelle dans l annee'
+
+      DO j = 1, jjp1
+      DO i = 1, iim
+          DO l = 1, lmdep
+            ax(l) = timeyear(l)
+            ay(l) = champtime (i,j,l)
+          ENDDO
+          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
+          DO k = 1, 360
+            time = FLOAT(k-1)
+            CALL SPLINT(ax,ay,yder,lmdep,time,by)
+            champan(i,j,k) = by
+          ENDDO
+      ENDDO
+      ENDDO
+      DO k = 1, 360
+      DO j = 1, jjp1
+         champan(iip1,j,k) = champan(1,j,k)
+      ENDDO
+        IF ( k.EQ.10 )  THEN
+          DO j = 1, jjp1
+            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
+            PRINT *,' Rugosite au temps 10 ', chmin,chmax,j
+          ENDDO
+        ENDIF
+      ENDDO
+c
+      DO k = 1, 360
+         CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
+      ENDDO
+c
+      ierr = NF_CLOSE(ncid)
+
+       DEALLOCATE( dlon      )
+       DEALLOCATE( dlon_ini  )
+       DEALLOCATE( dlat      )
+       DEALLOCATE( dlat_ini  )
+       DEALLOCATE( champ     )
+c
+c
+C Traitement de la glace oceanique
+c
+      PRINT*, 'Traitement de la glace oceanique'
+c
+
+cIM22/02/2002
+cIM   ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
+cIM   ierr = NF_OPEN('amip79to95.nc', NF_NOWRITE, ncid)
+cIM   ierr = NF_OPEN('amipbc_sic_1x1_clim.nc', NF_NOWRITE, ncid)
+
+      ierr = NF_OPEN('amipbc_sic_1x1.nc', NF_NOWRITE, ncid)
+
+cIM22/02/2002
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+
+cIM22/02/2002
+cIM07/03/2002 AMIP.nc & amip79to95.nc
+cIM   ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
+cIM07/03/2002 amipbc_sic_1x1_clim.nc & amipbc_sic_1x1.nc
+      ierr = NF_INQ_VARID(ncid,'sicbcs',varid)
+cIM22/02/2002
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', imdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE ( dlon_ini(imdep) )
+      ALLOCATE (     dlon(imdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, jmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE ( dlat_ini(jmdep) )
+      ALLOCATE (     dlat(jmdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, lmdep
+cIM28/02/2002
+cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
+c               Ici on suppose qu'on a 12 mois (de 30 jours).
+      IF (lmdep.NE.12) THEN
+          print *, 'Unknown AMIP file: not 12 months ?'
+          STOP
+       ENDIF
+cIM28/02/2002
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+c
+      ALLOCATE ( champ(imdep*jmdep) )
+
+      DO l = 1, lmdep
+         dimfirst(1) = 1
+         dimfirst(2) = 1
+         dimfirst(3) = l
+c
+         dimlast(1) = imdep
+         dimlast(2) = jmdep
+         dimlast(3) = 1
+c
+         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
+         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
+         if (ierr.ne.0) then
+           print *, NF_STRERROR(ierr)
+           STOP
+         ENDIF
+ 
+         title = 'Sea-ice Amip '
+c
+         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
+     .                        dlon, dlat, champ, interbar          )
+c
+      IF( oldice )  THEN
+                 CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
+     .             iim, jjp1, rlonv, rlatu, champint )
+      ELSEIF ( interbar )  THEN
+       IF( l.EQ.1 )  THEN
+        WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour Sea-ice Amip  $$$ '
+        WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+       ENDIF
+cIM07/03/2002 
+cIM22/02/2002 : Sea-ice Amip entre 0. et 1.
+cIM    PRINT*,'SUB. limit_netcdf.F IM : Sea-ice et SST Amip_new clim' 
+cIM   DO j = 1, imdep * jmdep
+cIM28/02/2002 <==PM         champ(j) = champ(j)/100.
+cIM14/03/2002      champ(j) = max(0.0,(min(1.0, (champ(j)/100.) )))
+cIM      champ(j) = amax1(0.0,(amin1(1.0, (champ(j)/100.) )))
+cIM   ENDDO
+cIM22/02/2002
+         CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
+     ,     champ, iim, jjm, rlonu, rlatv, jjp1, champint )
+      ELSE
+         CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
+     .             iim, jjp1, rlonv, rlatu, champint )
+      ENDIF
+         DO j = 1,jjp1
+         DO i = 1, iim
+            champtime (i,j,l) = champint(i,j)
+         ENDDO
+         ENDDO
+      ENDDO
+c
+      DO l = 1, lmdep
+cIM28/02/2002 <== PM  timeyear(l) = timecoord(l)
+cIM      timeyear(l) = timecoord(l)
+cIM07/03/2002      
+         timeyear(l) = tmidmonth(l)
+      ENDDO
+      PRINT 222,  timeyear
+c
+      PRINT*, 'Interpolation temporelle'
+      DO j = 1, jjp1
+      DO i = 1, iim
+          DO l = 1, lmdep
+            ax(l) = timeyear(l)
+            ay(l) = champtime (i,j,l)
+          ENDDO
+          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
+          DO k = 1, 360
+            time = FLOAT(k-1)
+            CALL SPLINT(ax,ay,yder,lmdep,time,by)
+            champan(i,j,k) = by
+          ENDDO
+      ENDDO
+      ENDDO
+      DO k = 1, 360
+      DO j = 1, jjp1
+         champan(iip1, j, k) = champan(1, j, k)
+      ENDDO
+        IF ( k.EQ.10 )  THEN
+          DO j = 1, jjp1
+            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
+            PRINT *,' Sea ice au temps 10 ', chmin,chmax,j
+          ENDDO
+        ENDIF
+      ENDDO
+c
+cIM14/03/2002 : Sea-ice Amip entre 0. et 1.
+      PRINT*,'SUB. limit_netcdf.F IM : Sea-ice Amipbc '
+      DO k = 1, 360
+      DO j = 1, jjp1
+      DO i = 1, iim
+        champan(i, j, k) = 
+     $ amax1(0.0,(amin1(1.0,(champan(i, j, k)/100.))))
+      ENDDO
+        champan(iip1, j, k) = champan(1, j, k)
+      ENDDO
+      ENDDO
+cIM14/03/2002
+
+      DO k = 1, 360
+         CALL gr_dyn_fi(1, iip1, jjp1, klon,
+     .                  champan(1,1,k), phy_ice)
+        IF ( newlmt) THEN
+
+CPB  en attendant de mettre fraction de terre
+c
+          WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
+          WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
+c 
+          IF (fracterre ) THEN
+c            WRITE(*,*) 'passe dans cas fracterre' 
+            pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
+            pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
+            pctsrf_t(1:klon,is_sic,k) =   phy_ice(1:klon) 
+     $            - pctsrf_t(1:klon,is_lic,k)
+c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
+            WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
+              pctsrf_t(1:klon,is_sic,k) = 0.
+            END WHERE 
+            WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
+              pctsrf_t(1:klon,is_sic,k) = 0.
+              pctsrf_t(1:klon,is_oce,k) = 0.
+            END WHERE
+            DO i = 1, klon
+              IF ( 1. - zmasq(i) .GT. EPSFRA) THEN 
+                IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
+                  pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
+                  pctsrf_t(i,is_oce,k) = 0.
+                ELSE 
+                  pctsrf_t(i,is_oce,k) = 1 - zmasq(i) 
+     $                    - pctsrf_t(i,is_sic,k)
+                  IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
+                    pctsrf_t(i,is_oce,k) = 0.
+                    pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
+                  ENDIF 
+                ENDIF
+              ENDIF  
+              if (pctsrf_t(i,is_oce,k) .lt. 0.) then
+                WRITE(*,*) 'pb sous maille au point : i,k '
+     $              , i,k,pctsrf_t(:,is_oce,k)
+              ENDIF
+              IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) + 
+     $          pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k)  - 1.) 
+     $            .GT. EPSFRA) THEN 
+                  WRITE(*,*) 'physiq : pb sous surface au point ', i, 
+     $                pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
+              ENDIF 
+            END DO
+          ELSE 
+            DO i = 1, klon
+              pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
+              IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
+                pctsrf_t(i,is_sic,k) = 0.
+                pctsrf_t(i,is_oce,k) = 0.                  
+                IF(phy_ice(i) .GE. 1.e-5) THEN
+                  pctsrf_t(i,is_lic,k) = phy_ice(i)
+                  pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k) 
+     .                                   - pctsrf_t(i,is_lic,k)
+                ELSE
+                  pctsrf_t(i,is_lic,k) = 0.
+                ENDIF 
+              ELSE
+                pctsrf_t(i,is_lic,k) = 0. 
+                IF(phy_ice(i) .GE. 1.e-5) THEN 
+                  pctsrf_t(i,is_ter,k) = 0.
+                  pctsrf_t(i,is_sic,k) = phy_ice(i)
+                  pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
+                ELSE
+                  pctsrf_t(i,is_sic,k) = 0.
+                  pctsrf_t(i,is_oce,k) = 1.                      
+                ENDIF 
+              ENDIF
+              verif = pctsrf_t(i,is_ter,k) +
+     .                pctsrf_t(i,is_oce,k) + 
+     .                pctsrf_t(i,is_sic,k) +
+     .                pctsrf_t(i,is_lic,k)
+              IF ( verif .LT. 1. - 1.e-5 .OR. 
+     $             verif .GT. 1 + 1.e-5) THEN  
+                WRITE(*,*) 'pb sous maille au point : i,k,verif '
+     $                    , i,k,verif
+              ENDIF 
+            END DO
+          ENDIF 
+        ELSE  
+          DO i = 1, klon
+            phy_nat(i,k) = phy_nat0(i)
+            IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
+              IF (NINT(phy_nat0(i)).EQ.0) THEN
+                phy_nat(i,k) = 3.0
+              ELSE
+                phy_nat(i,k) = 2.0
+              ENDIF
+            ENDIF
+            IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
+              IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
+            ENDIF
+          END DO
+        ENDIF
+      ENDDO
+c
+
+      ierr = NF_CLOSE(ncid)
+c
+       DEALLOCATE( dlon      )
+       DEALLOCATE( dlon_ini  )
+       DEALLOCATE( dlat      )
+       DEALLOCATE( dlat_ini  )
+       DEALLOCATE( champ     )
+
+477    continue
+c
+C Traitement de la sst
+c
+      PRINT*, 'Traitement de la sst'
+cIM22/02/2002
+cIM   ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
+cIM   ierr = NF_OPEN('amip79to95.nc', NF_NOWRITE, ncid)
+cIM   ierr = NF_OPEN('amipbc_sst_1x1_clim.nc', NF_NOWRITE, ncid)
+
+      ierr = NF_OPEN('amipbc_sst_1x1.nc', NF_NOWRITE, ncid)
+cIM22/02/2002
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+
+cIM22/02/2002
+cIM   ierr = NF_INQ_VARID(ncid,'SST',varid)
+      ierr = NF_INQ_VARID(ncid,'tosbcs',varid)
+cIM22/02/2002
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable SST ', namedim,'dimension ', imdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+ 
+      ALLOCATE( dlon_ini(imdep) )
+      ALLOCATE(     dlon(imdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
+#endif
+
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable SST ', namedim, 'dimension ', jmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE( dlat_ini(jmdep) )
+      ALLOCATE(     dlat(jmdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', lmdep
+cIM28/02/2002
+cPM28/02/2002 : nouvelle coord temporelle fichiers AMIP pas en jours
+c               Ici on suppose qu'on a 12 mois (de 30 jours).
+      IF (lmdep.NE.12) THEN
+          print *, 'Unknown AMIP file: not 12 months ?'
+          STOP
+       ENDIF
+cIM28/02/2002
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+       ALLOCATE( champ(imdep*jmdep) )
+       IF( extrap )   THEN
+         ALLOCATE ( work(imdep,jmdep) )
+       ENDIF
+c
+      DO l = 1, lmdep
+         dimfirst(1) = 1
+         dimfirst(2) = 1
+         dimfirst(3) = l
+c
+         dimlast(1) = imdep
+         dimlast(2) = jmdep
+         dimlast(3) = 1
+c
+         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
+         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
+         if (ierr.ne.0) then
+           print *, NF_STRERROR(ierr)
+           STOP
+         ENDIF
+
+         title='Sst Amip'
+c
+         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
+     .                            dlon, dlat, champ, interbar     )
+       IF ( extrap )  THEN
+        CALL extrapol(champ, imdep, jmdep, 999999.,.TRUE.,.TRUE.,2,work)
+       ENDIF
+c
+
+      IF ( interbar )  THEN
+        IF( l.EQ.1 )  THEN
+         WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour la Sst Amip $$$ '
+         WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+        ENDIF
+       CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
+     , champ, iim, jjm, rlonu, rlatv, jjp1, champint )
+      ELSE
+       CALL grille_m(imdep, jmdep, dlon, dlat, champ,
+     .          iim, jjp1, rlonv, rlatu, champint   )
+      ENDIF
+
+         DO j = 1,jjp1
+         DO i = 1, iim
+            champtime (i,j,l) = champint(i,j)
+         ENDDO
+         ENDDO
+      ENDDO
+c
+      DO l = 1, lmdep
+cIM28/02/2002 <==PM  timeyear(l) = timecoord(l)
+         timeyear(l) = tmidmonth(l)
+      ENDDO
+      print 222,  timeyear
+c
+C interpolation temporelle
+      DO j = 1, jjp1
+      DO i = 1, iim
+          DO l = 1, lmdep
+            ax(l) = timeyear(l)
+            ay(l) = champtime (i,j,l)
+          ENDDO
+          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
+          DO k = 1, 360
+            time = FLOAT(k-1)
+            CALL SPLINT(ax,ay,yder,lmdep,time,by)
+            champan(i,j,k) = by
+          ENDDO
+      ENDDO
+      ENDDO
+      DO k = 1, 360
+      DO j = 1, jjp1
+         champan(iip1,j,k) = champan(1,j,k)
+      ENDDO
+        IF ( k.EQ.10 )  THEN
+          DO j = 1, jjp1
+            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
+            PRINT *,' SST au temps 10 ', chmin,chmax,j
+          ENDDO
+        ENDIF
+      ENDDO
+c
+cIM14/03/2002 : SST amipbc greater then 271.38
+      PRINT*,'SUB. limit_netcdf.F IM : SST Amipbc >= 271.38 '
+      DO k = 1, 360
+      DO j = 1, jjp1
+      DO i = 1, iim
+         champan(i, j, k) = amax1(champan(i, j, k), 271.38)
+      ENDDO
+         champan(iip1, j, k) = champan(1, j, k)
+      ENDDO
+      ENDDO
+cIM14/03/2002
+      DO k = 1, 360
+         CALL gr_dyn_fi(1, iip1, jjp1, klon, 
+     .                  champan(1,1,k), phy_sst(1,k))
+      ENDDO
+c
+      ierr = NF_CLOSE(ncid)
+c
+       DEALLOCATE( dlon      )
+       DEALLOCATE( dlon_ini  )
+       DEALLOCATE( dlat      )
+       DEALLOCATE( dlat_ini  )
+       DEALLOCATE( champ     )
+c
+C Traitement de l'albedo
+c
+      PRINT*, 'Traitement de l albedo'
+      ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF
+      ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', imdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE ( dlon_ini(imdep) )
+      ALLOCATE (     dlon(imdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', jmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+
+      ALLOCATE ( dlat_ini(jmdep) )
+      ALLOCATE (     dlat(jmdep) )
+
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+      print*,'variable ', namedim, 'dimension ', lmdep
+      ierr = NF_INQ_VARID(ncid,namedim,dimid)
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
+#else
+      ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
+#endif
+      if (ierr.ne.0) then
+        print *, NF_STRERROR(ierr)
+        STOP
+      ENDIF 
+c
+      ALLOCATE ( champ(imdep*jmdep) )
+
+      DO l = 1, lmdep
+         dimfirst(1) = 1
+         dimfirst(2) = 1
+         dimfirst(3) = l
+c
+         dimlast(1) = imdep
+         dimlast(2) = jmdep
+         dimlast(3) = 1
+c
+         PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
+#else
+         ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
+#endif
+         if (ierr.ne.0) then
+           print *, NF_STRERROR(ierr)
+           STOP
+         ENDIF
+
+         title='Albedo Amip'
+c
+         CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
+     .                            dlon, dlat, champ, interbar      )
+c
+c
+      IF ( interbar )  THEN
+        IF( l.EQ.1 )  THEN
+         WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+         WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour l Albedo Amip $$$ '
+         WRITE(6,*) '-------------------------------------------------',
+     ,'------------------------'
+        ENDIF
+
+       CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
+     , champ, iim, jjm, rlonu, rlatv, jjp1, champint )
+      ELSE
+       CALL grille_m(imdep, jmdep, dlon, dlat, champ,
+     .          iim, jjp1, rlonv, rlatu, champint   )
+      ENDIF
+c
+         DO j = 1,jjp1
+         DO i = 1, iim
+            champtime (i, j, l) = champint(i, j)
+         ENDDO
+         ENDDO
+      ENDDO
+c
+      DO l = 1, lmdep
+         timeyear(l) = timecoord(l)
+      ENDDO
+      print 222,  timeyear
+c
+C interpolation temporelle
+      DO j = 1, jjp1
+      DO i = 1, iim
+          DO l = 1, lmdep
+            ax(l) = timeyear(l)
+            ay(l) = champtime (i, j, l)
+          ENDDO
+          CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
+          DO k = 1, 360
+            time = FLOAT(k-1)
+            CALL SPLINT(ax,ay,yder,lmdep,time,by)
+            champan(i,j,k) = by
+          ENDDO
+      ENDDO
+      ENDDO
+      DO k = 1, 360
+      DO j = 1, jjp1
+         champan(iip1, j, k) = champan(1, j, k)
+      ENDDO
+        IF ( k.EQ.10 )  THEN
+          DO j = 1, jjp1
+            CALL minmax( iip1,champan(1,j,10),chmin,chmax )
+            PRINT *,' Albedo au temps 10 ', chmin,chmax,j
+          ENDDO
+        ENDIF
+      ENDDO
+c
+      DO k = 1, 360
+         CALL gr_dyn_fi(1, iip1, jjp1, klon,
+     .                  champan(1,1,k), phy_alb(1,k))
+      ENDDO
+c
+      ierr = NF_CLOSE(ncid)
+c
+c
+      DO k = 1, 360
+      DO i = 1, klon
+         phy_bil(i,k) = 0.0
+      ENDDO
+      ENDDO
+c
+      PRINT*, 'Ecriture du fichier limit'
+c
+      ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
+     .                       "Fichier conditions aux limites")
+      ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
+      ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
+c
+      dims(1) = ndim
+      dims(2) = ntim
+c
+      ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
+      ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
+     .                        "Jour dans l annee")
+      IF (newlmt) THEN
+c
+        ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
+        ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
+     .                      "Fraction ocean")
+c
+        ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
+        ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
+     .                      "Fraction glace de mer")
+c
+        ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
+        ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
+     .                      "Fraction terre")
+c
+        ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
+        ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
+     .                      "Fraction land ice")
+c
+      ELSE 
+        ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
+        ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
+     .                      "Nature du sol (0,1,2,3)")
+      ENDIF 
+      ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
+      ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
+     .                      "Temperature superficielle de la mer")
+      ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
+      ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
+     .                        "Reference flux de chaleur au sol")
+      ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
+      ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
+     .                        "Albedo a la surface")
+      ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
+      ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
+     .                        "Rugosite")
+c
+      ierr = NF_ENDDEF(nid)
+c
+      DO k = 1, 360
+c
+      debut(1) = 1
+      debut(2) = k
+      epais(1) = klon
+      epais(2) = 1
+c
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
+c
+      IF (newlmt ) THEN
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
+     $        ,pctsrf_t(1,is_oce,k))
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
+     $        ,pctsrf_t(1,is_sic,k))
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
+     $        ,pctsrf_t(1,is_ter,k))
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
+     $        ,pctsrf_t(1,is_lic,k))
+      ELSE 
+          ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
+     $        ,phy_nat(1,k))
+      ENDIF 
+c
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
+      ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
+#else
+      ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
+      IF (newlmt ) THEN
+          ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
+     $        ,pctsrf_t(1,is_oce,k))
+          ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
+     $        ,pctsrf_t(1,is_sic,k))
+          ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
+     $        ,pctsrf_t(1,is_ter,k))
+          ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
+     $        ,pctsrf_t(1,is_lic,k))
+      ELSE 
+          ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
+     $        ,phy_nat(1,k))
+      ENDIF 
+      ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
+      ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
+#endif
+c
+      ENDDO
+c
+      ierr = NF_CLOSE(nid)
+c
+      STOP
+      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/minmax2.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/minmax2.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/minmax2.F	(revision 497)
@@ -0,0 +1,17 @@
+       SUBROUTINE minmax2(imax, jmax, lmax, xi, zmin, zmax )
+c
+       INTEGER lmax,jmax,imax
+       REAL xi(imax*jmax*lmax) 
+       REAL zmin,zmax
+       INTEGER i
+    
+       zmin = xi(1)
+       zmax = xi(1)
+
+       DO i = 2, imax*jmax*lmax
+         zmin = MIN( zmin,xi(i) )
+         zmax = MAX( zmax,xi(i) )
+       ENDDO
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/minmax2F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/minmax2F	(revision 3)
+++ 	(revision )
@@ -1,17 +1,0 @@
-       SUBROUTINE minmax2(imax, jmax, lmax, xi, zmin, zmax )
-c
-       INTEGER lmax,jmax,imax
-       REAL xi(imax*jmax*lmax) 
-       REAL zmin,zmax
-       INTEGER i
-    
-       zmin = xi(1)
-       zmax = xi(1)
-
-       DO i = 2, imax*jmax*lmax
-         zmin = MIN( zmin,xi(i) )
-         zmax = MAX( zmax,xi(i) )
-       ENDDO
-
-       RETURN
-       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/modif_etat0.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/modif_etat0.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/modif_etat0.F	(revision 497)
@@ -0,0 +1,259 @@
+      PROGRAM modif_etat0
+      
+      USE startvar
+      USE ioipsl
+      !
+      IMPLICIT NONE
+      !
+#include "dimensions.h"
+#include "paramet.h"
+      !
+      !
+#include "dimphy.h"
+      !
+#include "comgeom2.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "indicesol.h"
+#include "dimsoil.h"
+      !
+      REAL :: latfi(klon), lonfi(klon)
+      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1), masque(iip1,jjp1),
+     . psol(iip1, jjp1), phis(iip1, jjp1)
+      REAL :: tsol(klon,nbsrf), qsol(klon,nbsrf), sn(klon,nbsrf)
+      REAL :: evap(klon,nbsrf), albe(klon,nbsrf)
+      real :: rain_fall(klon), snow_fall(klon)
+      real :: sollw(klon), solsw(klon)
+      REAL :: radsol(klon),deltat(klon), rugmer(klon), agesno(klon)
+      REAL :: zmea(iip1*jjp1), zstd(iip1*jjp1)
+      REAL :: zsig(iip1*jjp1), zgam(iip1*jjp1), zthe(iip1*jjp1)
+      REAL :: zpic(iip1*jjp1), zval(iip1*jjp1), rugsrel(iip1*jjp1)
+      REAL :: pctsrf(klon, nbsrf)
+      REAL :: tsoil(klon, nsoilmx, nbsrf)
+      REAL :: t_ancien(klon, klev), q_ancien(klon, klev)
+      REAL :: tabcntrl0(100)
+      LOGICAL :: ancien_ok
+      ! declarations pour lecture glace de mer
+      INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
+      INTEGER :: itau(1), fid
+      REAL :: lev(1), date, dt
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
+      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_lic, dlat_lic
+      REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
+      REAL :: flic_tmp(iip1, jjp1)
+      REAL :: champint(iim, jjp1)
+      !
+      CHARACTER*80 :: varname
+      !
+#include "comdissnew.h"
+#include "control.h"
+#include "serre.h"
+#include "clesph0.h"
+
+      INTEGER  ::        longcles
+      PARAMETER      ( longcles  = 20 )
+      REAL :: clesphy0 ( longcles       )
+      REAL ::phystep,co2_ppm,solaire
+      REAL :: unskap
+      INTEGER :: radpas
+
+      CHARACTER*80 :: visu_file
+      INTEGER :: visuid
+      !
+      ! indices de boucle 
+      INTEGER :: ji
+      !   Constantes 
+      !
+      pi     = 4. * ATAN(1.)
+      rad    = 6371229.
+      omeg   = 4.* ASIN(1.)/(24.*3600.)
+      g      = 9.8
+      daysec = 86400.
+      kappa  = 0.2857143
+      cpp    = 1004.70885
+      !
+      preff     = 101325.
+      unskap = 1./kappa
+      !
+      jmp1    = jjm + 1
+      !
+      !    Construct a grid
+      !
+
+      CALL defrun_new(99,.TRUE.,clesphy0)
+
+      dtvr   = daysec/FLOAT(day_step)
+      print*,'dtvr',dtvr
+
+      CALL inicons0()
+      CALL inigeom()
+      !
+      CALL inifilr()
+      !
+      !
+      !! 1. READ orography 
+      !
+      varname = 'relief'
+      ! This line needs to be replaced by a call to restget to get the values in the restart file
+      orog(:,:) = 0.0
+       CALL startget(varname, iip1, jjp1, rlonv, rlatu, orog, 0.0)
+      !
+      WRITE(*,*) 'OUT OF GET VARIABLE : Relief'
+      WRITE(*,'(49I1)') INT(orog(:,:))
+      !
+      varname = 'rugosite'
+      ! This line needs to be replaced by a call to restget to get the values in the restart file
+      rugo(:,:) = 0.0
+       CALL startget(varname, iip1, jjp1, rlonv, rlatu, rugo, 0.0)
+      !
+      WRITE(*,*) 'OUT OF GET VARIABLE : Rugosite' 
+      WRITE(*,'(49I1)') INT(rugo(:,:)*10)
+      !
+      varname = 'masque'
+      ! This line needs to be replaced by a call to restget to get the values in the restart file
+      masque(:,:) = 0.0
+       CALL startget(varname, iip1, jjp1, rlonv, rlatu, masque, 0.0)
+      !
+      WRITE(*,*) 'MASQUE construit : Masque'
+      WRITE(*,*) masque(:,:)
+      WRITE(*,*) 'orographie'
+      WRITE(*,*) orog(:,:)
+      !
+      !! 2. create masque and READ land iice fraction
+      !!
+      ! lit bande startphy a modifier
+      !
+     
+      CALL phyetat0("startphy.nc", phystep, co2_ppm, solaire, latfi,  
+     $    lonfi, pctsrf, tsol, tsoil, deltat, qsol, sn, 
+     $    albe, evap, rain_fall, snow_fall, solsw, sollw,
+     $    radsol, rugmer, agesno, clesphy0, 
+     $    zmea, zstd, zsig, zgam, zthe, zpic, zval, 
+     $    rugsrel, tabcntrl0, t_ancien, q_ancien, ancien_ok)
+C
+C on initialise les sous surfaces
+C
+      pctsrf=0.
+      !cree le masque a partir du fichier relief
+      varname = 'zmasq'
+      zmasq(:) = 0.
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmasq,0.0)
+      WHERE (zmasq(1 : klon) .LE. EPSFRA)
+          zmasq(1 : klon) = 0.
+      END WHERE 
+      WRITE(*,*)zmasq
+      varname = 'zmea'
+      zmea(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0)
+      varname = 'zstd'
+      zstd(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0)
+      varname = 'zsig'
+      zsig(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0)
+      varname = 'zgam'
+      zgam(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0)
+      varname = 'zthe'
+      zthe(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0)
+      varname = 'zpic'
+      zpic(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0)
+      varname = 'zval'
+      zval(:) = 0.0
+      CALL startget(varname,iip1,jjp1,rlonv,rlatu,klon,zval,0.0)
+      rugsrel(:) = 0.0
+C
+C lecture du fichier glace de terre pour fixer la fraction de terre 
+C et de glace de terre
+C
+      CALL flininfo("landiceref.nc", iml_lic, jml_lic,llm_tmp, ttm_tmp
+     $    , fid)
+      ALLOCATE(lat_lic(iml_lic, jml_lic), stat=iret)
+      ALLOCATE(lon_lic(iml_lic, jml_lic), stat=iret)
+      ALLOCATE(dlon_lic(iml_lic), stat=iret)
+      ALLOCATE(dlat_lic(jml_lic), stat=iret)
+      ALLOCATE(fraclic(iml_lic, jml_lic), stat=iret)
+      CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp
+     $    , lon_lic, lat_lic, lev, ttm_tmp, itau, date, dt, fid)
+      CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp
+     $    , 1, 1, fraclic)
+      CALL flinclo(fid)
+C
+C interpolation sur la grille T du modele
+C
+      WRITE(*,*) 'dimensions de landice iml_lic, jml_lic : ', 
+     $    iml_lic, jml_lic
+c
+C sil les coordonnees sont en degres, on les transforme
+C
+      IF( MAXVAL( lon_lic(:,:) ) .GT. 2.0 * asin(1.0) )  THEN
+          lon_lic(:,:) = lon_lic(:,:) * 2.0* ASIN(1.0) / 180.
+      ENDIF 
+      IF( maxval( lat_lic(:,:) ) .GT. 2.0 * asin(1.0)) THEN 
+          lat_lic(:,:) = lat_lic(:,:) * 2.0 * asin(1.0) / 180.
+      ENDIF 
+
+      dlon_lic(1 : iml_lic) = lon_lic(1 : iml_lic, 1)
+      dlat_lic(1 : jml_lic) = lat_lic(1 , 1 : jml_lic) 
+C
+      CALL grille_m(iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic
+     $    ,iim, jjp1,
+     $    rlonv, rlatu, flic_tmp(1 : iim, 1 : jjp1))
+c$$$      flic_tmp(1 : iim, 1 : jjp1) = champint(1: iim, 1 : jjp1)
+      flic_tmp(iip1, 1 : jjp1) = flic_tmp(1 , 1 : jjp1)
+C
+C passage sur la grille physique
+C
+      CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp,
+     $    pctsrf(1:klon, is_lic))
+C adequation avec le maque terre/mer
+      WHERE (pctsrf(1 : klon, is_lic) .LE. EPSFRA ) 
+          pctsrf(1 : klon, is_lic) = 0. 
+      END WHERE
+      WHERE (zmasq( 1 : klon) .LE. EPSFRA) 
+          pctsrf(1 : klon, is_lic) = 0.
+      END WHERE 
+      pctsrf(1 : klon, is_ter) = zmasq(1 : klon)
+      DO ji = 1, klon
+        IF (zmasq(ji) .GT. EPSFRA) THEN 
+            IF ( pctsrf(ji, is_lic) .GE. zmasq(ji)) THEN
+                pctsrf(ji, is_lic) = zmasq(ji)
+                pctsrf(ji, is_ter) = 0.
+            ELSE 
+                pctsrf(ji,is_ter) = zmasq(ji) - pctsrf(ji, is_lic)
+            ENDIF 
+        ENDIF 
+      END DO 
+C
+C sous surface ocean et glace de mer (pour demarrer on met glace de mer a 0)
+C
+      pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon))
+      WHERE (pctsrf(1 : klon, is_oce) .LT. EPSFRA)
+          pctsrf(1 : klon, is_oce) = 0.
+      END WHERE 
+C
+C verif que somme des sous surface = 1
+C
+      ji=count( (abs( sum(pctsrf(1 : klon, 1 : nbsrf), dim = 2)) - 1.0 ) 
+     $    .GT. EPSFRA)
+      IF (ji .NE. 0) THEN
+          WRITE(*,*) 'pb repartition sous maille pour ',ji,' points'
+      ENDIF 
+C
+C Ecriture etat initial physique
+C
+      WRITE(*,*)'zmasq avant phyredem'
+      WRITE(*,*) zmasq
+
+      call phyredem("restartphy.nc",phystep,radpas, co2_ppm, solaire,
+     $    latfi, lonfi, pctsrf, tsol, tsoil, deltat, qsol, sn, 
+     $    albe, evap, rain_fall, snow_fall, solsw, sollw, 
+     $    radsol, rugmer,  agesno, 
+     $    zmea, zstd, zsig, zgam, zthe, zpic, zval, rugsrel, 
+     $    t_ancien, q_ancien)
+
+      CALL histclo
+      !
+      END  
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/nudge.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/nudge.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/nudge.F	(revision 497)
@@ -0,0 +1,228 @@
+c $Header$
+      subroutine nudge(itau,ucov,vcov,teta,masse,ps)
+
+      IMPLICIT NONE
+
+c      ......   Version  du 10/01/98    ..........
+
+c             avec  coordonnees  verticales hybrides 
+c   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
+
+c=======================================================================
+c
+c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
+c   -------
+c
+c   Objet:
+c   ------
+c
+c   GCM LMD nouvelle grille
+c
+c=======================================================================
+
+c   ...  Dans inigeom , nouveaux calculs pour les elongations  cu , cv 
+c        et possibilite d'appeler une fonction f(y)  a derivee tangente 
+c        hyperbolique a la  place de la fonction a derivee sinusoidale.         
+
+c   ...  Possibilite de choisir le shema de Van-leer pour l'advection de
+c         q  , en faisant iadv = 3  dans   traceur  (29/04/97) .
+c
+c-----------------------------------------------------------------------
+c   Declarations:
+c   -------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissnew.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+#include "tracstoke.h"
+
+
+c   variables dynamiques
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                 ! temperature potentielle 
+      REAL ps(ip1jmp1)                       ! pression  au sol
+      REAL masse(ip1jmp1,llm)                ! masse d'air
+
+c   variables dynamiques pour les reanalyses.
+      REAL ucovrea1(ip1jmp1,llm),vcovrea1(ip1jm,llm) !vts cov reas
+      REAL tetarea1(ip1jmp1,llm)             ! temp pot  reales
+      REAL masserea1(ip1jmp1,llm)             ! masse
+      REAL psrea1(ip1jmp1)             ! ps
+      REAL ucovrea2(ip1jmp1,llm),vcovrea2(ip1jm,llm) !vts cov reas
+      REAL tetarea2(ip1jmp1,llm)             ! temp pot  reales
+      REAL masserea2(ip1jmp1,llm)             ! masse
+      REAL psrea2(ip1jmp1)             ! ps
+      real alphaT,alphaP,alphau,alphav
+      real dday_step,toto,reste,itau_test
+      INTEGER step_rea,count_no_rea
+
+
+c
+      INTEGER itau,ij,l
+      real ditau,tau,a
+
+      LOGICAL first
+      integer online
+      save first,online
+      data first,online/.true.,1/
+
+      save ucovrea1,vcovrea1,tetarea1,masserea1,psrea1
+      save ucovrea2,vcovrea2,tetarea2,masserea2,psrea2
+
+      save alphaT,alphau,alphav,alphaP,itau_test
+      save step_rea,count_no_rea
+
+c-----------------------------------------------------------------------
+c   initialisations pour la lecture des reanalyses.
+c    alpha determine la part des injections de donnees a chaque etape
+c    alpha=1 signifie pas d'injection
+c    alpha=0 signifie injection totale
+c-----------------------------------------------------------------------
+
+      print*,'ONLINE=',online
+      if(online.eq.-1) then
+          return
+      endif
+
+      if (first) then
+         print*
+     s   ,'1: en-ligne, 0: hors-ligne (x=x_rea), -1: climat (x=x_gcm)'
+cnec         read(*,*) online
+cnec      online=-1
+cnec     print*,'Entrer les constantes de temps de rappel en jours'
+cnec         read(*,*)alphaT
+cnec         read(*,*)alphau
+cnec         read(*,*)alphav
+cnec         read(*,*)alphaP
+             alphaT=0.1
+             alphau=0.1
+             alphav=0.1
+             alphaP=1.e10
+         print*,'alphaT,alphau,alphav,alphaP'
+     s          ,alphaT,alphau,alphav,alphaP
+         if(online.eq.-1) return
+         print*,'alpha rappel pour T, u, v, P ',
+     s    alphaT,alphau,alphav,alphaP
+c   En fait, le coef alpha qu'on utilise est
+c   x_gcm = a * x_gcm + ( 1 - a ) * x_reanalys
+c   on a alors a=1-dt/tau
+c   ou dt est la frequence a laquelle on corrige (ici iperiod*dtvr)
+c   et tau la constante de temps lue. D'ou:
+         if (online.eq.1) then
+            alphaT=1.-iperiod*dtvr/(daysec*alphaT)
+            alphau=1.-iperiod*dtvr/(daysec*alphau)
+            alphav=1.-iperiod*dtvr/(daysec*alphav)
+            alphaP=1.-iperiod*dtvr/(daysec*alphaP)
+         else
+            alphaT=0.
+            alphau=0.
+            alphav=0.
+            alphaP=0.
+c           physic=.false.
+         endif
+         print*,'alpha rappel pour T, u, v, P ',
+     s    alphaT,alphau,alphav,alphaP
+
+         itau_test=1001
+         step_rea=1
+         count_no_rea=0
+
+c    itau_test    montre si l'importation a deja ete faite au rang itau
+
+
+c   Lecture du premier etat des reanalyses.
+         call read_reanalyse(1
+     s   ,ucovrea2,vcovrea2,tetarea2,masserea2,ps,1)
+
+c-----------------------------------------------------------------------
+c   Debut de l'integration temporelle:
+c   ----------------------------------
+
+         first=.false.
+      endif ! first
+c
+C-----------------------------------------------------------------------
+C----- IMPORTATION DES VENTS,PRESSION ET TEMPERATURE REELS:
+C-----------------------------------------------------------------------
+
+      ditau=real(itau)
+      dday_step=real(day_step)
+      write(*,*)'ditau,dday_step'
+      write(*,*)ditau,dday_step
+      toto=4*ditau/dday_step
+      reste=toto-aint(toto)
+c     write(*,*)'toto,reste',toto,reste
+
+      if (reste.eq.0.) then
+        if (itau_test.eq.itau) then
+          write(*,*)'deuxieme passage de advreel a itau=',itau
+          stop
+        else
+           CALL SCOPY( ijmllm ,vcovrea2, 1, vcovrea1 , 1 )
+           CALL SCOPY( ijp1llm,ucovrea2, 1, ucovrea1 , 1 )
+           CALL SCOPY( ijp1llm,tetarea2,1,tetarea1   , 1 )
+c          CALL SCOPY( ijp1llm,masserea2,1,masserea1   , 1 )
+c          CALL SCOPY( ip1jmp1,psrea2, 1,  psrea1, 1 )
+
+          print*,'LECTURE REANALYSES, pas ',step_rea
+     s         ,'apres ',count_no_rea,' non lectures'
+           step_rea=step_rea+1
+           itau_test=itau
+           call read_reanalyse(step_rea
+     s     ,ucovrea2,vcovrea2,tetarea2,masserea2,ps,1)
+        endif
+      else
+        count_no_rea=count_no_rea+1
+      endif
+ 
+C-----------------------------------------------------------------------
+c   Corrrections
+c
+c    x_gcm = a * x_gcm + (1-a) * x_reanalyses
+C-----------------------------------------------------------------------
+
+      ditau=real(itau)
+      dday_step=real(day_step)
+
+c     print*,'alpha1',alphaT,alphaP,alphau,alphav
+
+      tau=4*ditau/dday_step
+      tau=tau-aint(tau)
+
+      do l=1,llm
+         do ij=1,ip1jmp1
+            a=(1.-tau)*ucovrea1(ij,l)+tau*ucovrea2(ij,l)
+            ucov(ij,l)=alphau*ucov(ij,l)+(1-alphau)*a
+            a=(1.-tau)*tetarea1(ij,l)+tau*tetarea2(ij,l)
+            teta(ij,l)=alphaT*teta(ij,l)+(1-alphaT)*a
+c           a=(1.-tau)*masserea1(ij,l)+tau*masserea2(ij,l)
+c           masse(ij,l)=alphaP*masse(ij,l)+(1-alphaP)*a
+         enddo
+         do ij=1,ip1jm
+            a=(1.-tau)*vcovrea1(ij,l)+tau*vcovrea2(ij,l)
+            vcov(ij,l)=alphav*vcov(ij,l)+(1-alphav)*a
+         enddo
+      enddo
+
+c     call dump2d(iip1,jjp1,tetarea1,'TETA REA 1     ')
+c     call dump2d(iip1,jjp1,tetarea2,'TETA REA 2     ')
+c     call dump2d(iip1,jjp1,teta,'TETA           ')
+Cmaf  on ne nudge pas sur la pression de surface
+c      do ij=1,ip1jmp1
+c         a=(1.-tau)*psrea1(ij)+tau*psrea2(ij)
+c         ps(ij)=alphaP*ps(ij)+(1-alphaP)*a
+c      enddo
+
+
+      return
+      end
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/offline.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/offline.F	(revision 3)
+++ 	(revision )
@@ -1,640 +1,0 @@
-      PROGRAM offline
-      USE ioipsl
-      IMPLICIT NONE
-
-c      ......   Version  du 17/04/96    ..........
-c=======================================================================
-c
-c   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
-c   -------
-c   Modif special traceur F.Forget 05/94
-c
-c   Modifs M-A Filiberti 07/99
-C
-c   Objet:
-c   ------
-c
-c   GCM LMD nouvelle grille
-c
-c=======================================================================
-
-c   ...      modification de l'integration de q ( 26/04/94 )      ....
-
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comdissnew.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "logic.h"
-#include "temps.h"
-#include "control.h"
-#include "ener.h"
-#include "description.h"
-#include "serre.h"
-#include "tracstoke.h"
-      integer ngridmx,nbsrf
-      PARAMETER (ngridmx=iim*(jjm-1)+2,nbsrf=4)
-c-----------------------------------------------------------------------
-
-      INTEGER*4  iday ! jour julien
-      REAL       time ! Heure de la journee en fraction d'1 jour
-      REAL dtdyn,dtav
-      INTEGER iday_step
-
-      INTEGER         longcles
-      PARAMETER     ( longcles = 20 )
-      REAL  clesphy0( longcles )
-      logical clefinit
-
-
-c   variables dynamiques
-      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
-      REAL q(iip1,jjp1,llm,nqmx)               ! champs advectes
-      REAL pks(iip1,jjp1)                      ! exner (f pour filtre)
-      REAL phis(iip1,jjp1)                     ! geopotentiel au sol
-      REAL phi(iip1,jjp1,llm)                  ! geopotentiel
-      REAL w(iip1,jjp1,llm)                    ! vitesse verticale
-C
-C   variables physiques
-      real zmfd(ngridmx,llm),zde_d(ngridmx,llm),zen_d(ngridmx,llm)
-      REAL qfi(ngridmx,llm,nqmx)               ! champs advectes
-      real zmfu(ngridmx,llm),zde_u(ngridmx,llm),zen_u(ngridmx,llm)
-      real coefkz(ngridmx,llm)
-      real frac_impa(ngridmx,llm),frac_nucl(ngridmx,llm)
-      real pphis (ngridmx)
-      REAL airefi(ngridmx)
-      REAL latfi(ngridmx),lonfi(ngridmx) ! latitude et long pour chaque point
-      real yu1(ngridmx), yv1(ngridmx)
-      real ftsol(ngridmx,nbsrf),pctsrf(ngridmx,nbsrf)
-
-C
-      character*10 file
-
-c variables dynamiques intermediaire pour le transport
-      REAL pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm) !flux de masse
-
-      REAL masse(iip1,jjp1,llm)
-      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
-      REAL teta(iip1,jjp1,llm)
-
-      INTEGER itau,irec,nrec,ldec,itauav
-      integer recmin,recmax,recstkmin,recstkmax
-      character*1 injecte,stoke
-      character*10 nom
-
-      integer jour0,isplit,nsplit_dyn,nsplit_phy,nsplit
-      logical debut,lectstart,rnpb
-
-      EXTERNAL inidissip,iniconst,inifilr
-      EXTERNAL inigeom
-      EXTERNAL exner_hyb,pression
-      EXTERNAL defrun_new
-
-      REAL time_0 ! temps de debut de simulation (% journee)
-
-      character*2 str2
-      INTEGER iq,j,i,l,nq,mode
-
-      real paprs(ngridmx,llm+1),pplay(ngridmx,llm),tempfi(ngridmx,llm)
-      real p(iip1,jjp1,llmp1),pk(iip1,jjp1,llm)
-
-      real lon_stat(nqmx),lat_stat(nqmx),zlon,zlat
-      integer i_stat(nqmx),j_stat(nqmx)
-      real intensite(nqmx)
-
-      integer iqmin,iqmax
-      integer npasinject
-      data npasinject/1/
-
-      integer histid, histvid, histaveid
-      real time_step, t_wrt, t_ops
-      integer itime_step
-      character*80 dynhist_file, dynhistave_file
-
-
-      logical avant
-
-      logical debutphy,redecoupage
-      DATA debutphy/.true./
-      
-      real unskap,pksurcp,smass(iip1,jjp1)
-      integer ig0,ii,jj,iii,ij
-
-     
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
-      REAL ps(iip1,jjp1),pkf(ip1jmp1,llm) 
-
-
-c-----------------------------------------------------------------------
-c   Initialisations:
-c   ----------------
-
-      descript = 'Run GCM LMDZ'
-
-c-----------------------------------------------------------------------
-
-
-      rad = 6400000
-      omeg = 7.272205e-05
-      g = 9.8
-      kappa = 0.285716
-      daysec = 86400
-      cpp = 1004.70885
-Cmaf a verifier....
-      preff = 101325.
-      pa= 50000.
-C
-
-      print*,'Nombre effectif de traceurs'
-      read(*,*) nq
-      write(*,*) nq
-      print*,'Splitting du pas de temps dynamique'
-      read(*,*) nsplit_dyn
-      write(*,*) nsplit_dyn
-      print*,'Splitting du pas de temps physique'
-      read(*,*) nsplit_phy
-      write(*,*) nsplit_phy
-      print*,'jour0, par rapport au debut du fichier fluxmass'
-      read(*,*) jour0
-      write(*,*) jour0
-      print*,'redecoupage (T) ou standard (F)'
-      read(*,'(l1)') redecoupage
-      write(*,*) redecoupage
-      print*,'Lecture fichier start (T)?'
-      read(*,'(l1)') lectstart
-      write(*,'(l1)') lectstart
-      print*,'Traceurs 1 et 2 = Rn222 et Pb'
-      read(*,'(l1)') rnpb
-      write(*,'(l1)') rnpb
-      print*,'Avant T ou arriere F?'
-      read(*,'(l1)') avant
-      write(*,'(l1)') avant
-      print*,'Index min et max des traceurs a initaliser'
-      read(*,*) iqmin,iqmax
-      write(*,*) iqmin,iqmax
-      print*,'localisation (lon, lat, intensite)'
-      if(iqmax.le.0) then
-         iqmin=iqmax+1
-      endif
-      do iq=iqmin,iqmax
-         read(*,*) lon_stat(iq),lat_stat(iq),intensite(iq)
-         write(*,*) lon_stat(iq),lat_stat(iq),intensite(iq)
-      enddo
-      print*,'Injection sur combien de pas de temps'
-      read(*,*) npasinject
-      write(*,*) npasinject
-      print*,'Records min et max pour le stokage et couche '
-     s    ,'verticale (specifique reseaux), def 0 0 1'
-      read(*,*) recstkmin,recstkmax,ldec
-      write(*,*) recstkmin,recstkmax,ldec
-
-c   redefinition du splitting
-      if(mod(nsplit_dyn,nsplit_phy).eq.0) then
-         nsplit=nsplit_phy
-      elseif (mod(nsplit_phy,nsplit_dyn).eq.0) then
-         nsplit=nsplit_dyn
-      else
-         stop'prendre un des deux nsplit doit diviser l autre'
-      endif
-      nsplit_dyn=nsplit_dyn/nsplit
-      nsplit_phy=nsplit_phy/nsplit
-      print*,'nsplit,nsplit_dyn,nsplit_phy'
-     s       ,nsplit,nsplit_dyn,nsplit_phy
-c   Lecture eventuelle 
-      time_0=0.
-
-      if(nq.gt.nqmx) stop'surdimensioner nqmx'
-
-      print*,'av initial0'
-      call initial0(nq*ijp1llm,q)
-
-      print*,'av lectstart'
-      if(lectstart) then
-         CALL dynetat0("start.nc",nq,vcov,ucov,
-     .              teta,q,masse,ps,phis, time_0)
-         print*,'Lecture du start'
-      else
-         day_ini=0
-         anne_ini=0
-      endif
-      day_end=day_ini+nday
-
-
-      print*,'av defrun'
-c     open (99,file='run.def',status='old',form='formatted')
-      clefinit=.true.
-      CALL defrun_new( 99, clefinit, clesphy0 )
-c     close(99)
-
-      print*,'av iniconst'
-c   lecture du jour de demarrage
-c    premiere initialisation, eventuellement bidon
-      CALL iniconst
-      CALL inigeom
-
-C
-c  Lecture des entetes des fichiers de flux
-      if(redecoupage) then
-         call redecoupe(0,masse,pbaru,pbarv,w,teta,phi,
-     s     nrec,avant,airefi,
-     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
-     s     yu1,yv1,ftsol,pctsrf,
-     s     frac_impa,frac_nucl)
-      else
-         call lectflux(0,masse,pbaru,pbarv,w,teta,phi,
-     s     nrec,avant,airefi,
-     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
-     s     yu1,yv1,ftsol,pctsrf,
-     s     frac_impa,frac_nucl,phis)
-         call inigeom
-      endif
-
-c   controle sur les records
-      if(avant) then
-         recmin=2+(jour0-1)*iday_step
-         recmax=1+(jour0+nday-1)*iday_step
-      else
-         recmin=(jour0-nday)*iday_step+2
-         recmax=jour0*iday_step+1
-      endif
-      if(recmin.le.1.or.recmax.ge.nrec) then
-         print*,'Probleme de lecture '
-         print*,'recmin,recmax,nrec',recmin,recmax,nrec
-         stop
-      endif
-
-C on recalcule le nombre de pas de temps dans une journee
-c   istdyn est la frequence de stokage en "pas de temps dynamique" dans
-c   le modele on-line. dtvr est le pas de temps du meme modele en s.
-c iday-step est le nombre de lectures par jour (grand pas de temps). 
-      iday_step=daysec/(istdyn*dtvr)
-C
-      CALL iniconst
-c  on calcule le pas de temps 
-      dtvr    = daysec/FLOAT(iday_step)
-      dtphys=dtvr/(nsplit*nsplit_phy) ! a mettre apres iniconst!
-      print*,'Pas de temps physique ',dtphys
-
-
-C
-
-      call gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
-
-      print *,'Pas de temps dynamique', dtvr
-      print*,'Pas de temps physique ',dtphys
-
-c-----------------------------------------------------------------------
-C maf est ce utile ?
-
-      call suphec
-
-      CALL inifilr
-      print*,'Pas de temps physique ',dtphys
-      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
-     *                tetagdiv, tetagrot , tetatemp              )
-      print*,'Pas de temps physique ',dtphys
-
-c-----------------------------------------------------------------------
-c   temps de depart et de fin:
-c   --------------------------
-
-      itau = 0
-      iday = dayref
-      time = time_0
-         IF(time.GT.1.) THEN
-          time = time-1.
-          iday = iday+1
-         ENDIF
-      print*,'Pas de temps physique ',dtphys
-
-c=======================================================================
-c   Initialisation des fichiers de sortie
-c=======================================================================
-
-      print*,'Initialisation de wrgras'
-      file='sol'
-      call inigrads(1,iip1
-     s  ,rlonv,180./pi,-190.,190.,jjp1,rlatu,-90.,90.,180./pi
-     s  ,llm,presnivs,1.
-     s  ,dtphys,file,'gcmq2 ')
-      file='atm'
-      print*,'Pas de temps physique ',dtphys
-      call inigrads(2,iip1
-     s  ,rlonv,180./pi,-190.,190.,jjp1,rlatu,-90.,90.,180./pi
-     s  ,llm,presnivs,1.
-     s  ,dtphys,file,'gcmq2 ')
-
-      print*,'dtphys ap inigrads ',dtphys
-
-      print*,'Ecriture du fichier de conditions aux limites'
-      open (98,file='limit',form='unformatted')
-      write(98) float(im),float(jm),float(nq),float(nday)
-      write(98) (rlonv(i)*180./pi,i=1,iip1)
-      write(98) (rlatu(j)*180./pi,j=1,jjp1)
-      write(98) ((phis(i,j)/g,i=1,iip1),j=1,jjp1)
-      close(98)
-
-      CALL dynredem0("restart.nc",day_end,anne_ini,phis,nq)
-
-c-----------------------------------------------------------------------
-c   Debut de la boucle en temps:
-c   ----------------------------
-
-      do itau=1,nday*iday_step
-
-          print*,'ITAU ITAU ITAU =',itau
-         injecte='.'
-         stoke='.'
-
-c Gestion du temps
-         if (avant) then
-            dtdyn=dtvr/float(nsplit*nsplit_dyn)
-            irec=1+(jour0-1)*iday_step+itau
-         else
-            dtdyn=-dtvr/float(nsplit*nsplit_dyn)
-            irec=1+jour0*iday_step-itau+1
-         endif
-
-         debut=itau.eq.1
-
-c-----------------------------------------------------------------------
-c   Lecture des fichiers fluxmass et physique:
-c   -----------------------------------------------------
-
-         print*,'CCCCC Appel a redecoupe au pas itau=',itau
-      if(redecoupage) then
-         call redecoupe(irec,masse,pbaru,pbarv,w,teta,phi,
-     s     nrec,avant,airefi,
-     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
-     s     yu1,yv1,ftsol,pctsrf, 
-     s     frac_impa,frac_nucl)
-      else
-         call lectflux(irec,masse,pbaru,pbarv,w,teta,phi,
-     s     nrec,avant,airefi,
-     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
-     s     yu1,yv1,ftsol,pctsrf, 
-     s     frac_impa,frac_nucl,phis)
-      endif
-
-c    ...  ouverture du fichier de stockage netcdf ...
-C
-      IF (debut) then
-         dynhistave_file = 'dyn_hist_ave.nc'
-         day_ini=0
-         anne_ini=0
-         t_ops = periodav * daysec
-         t_wrt = periodav * daysec
-         dtav=dtvr/float(nsplit)
-         mode=1
-         CALL initdynav(dynhistave_file,day_ini,anne_ini,dtav,
-     .              t_ops, t_wrt, nq, histaveid)
-         pi=2.*asin(1.)
-         do iq=iqmin,iqmax
-            do l=1,llm
-               do j=1,jjp1
-                  do i=1,iip1
-                     q(i,j,l,iq)=0.
-                  enddo
-               enddo
-            enddo
-            zlon=lon_stat(iq)*pi/180.
-            zlat=lat_stat(iq)*pi/180.
-            CALL coordij(zlon,zlat,i_stat(iq),j_stat(iq))
-         enddo
-      ENDIF
-
-C calcul de la pression de surface.
-      do j=1,jjp1
-         do i=1,iip1
-            smass(i,j)=0.
-         enddo
-      enddo
-      do l=1,llm
-        do j=1,jjp1
-          do i=1,iip1
-             smass(i,j)=smass(i,j)+masse(i,j,l)
-          enddo
-       enddo
-      enddo
-      do j=1,jjp1
-         do i=1,iip1
-            ps (i,j)=smass(i,j)/aire(i,j)*g
-         end do
-      end do
-C
-C calcul de la pression et de pk (fonction d'Exner)
-C
-      CALL pression ( ip1jmp1, ap, bp, ps, p       )
-      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-c
-C
-      do jj=1,jjp1
-         do ii=1,iip1
-           phis(ii,jj)= phi(ii,jj,1)-teta(ii,jj,1)*
-     s                             (pks(ii,jj)-pk(ii,jj,1))
-         end do
-      end do
-
-c=======================================================================
-c   TERMES SOURCES OU PUITS
-c=======================================================================
-c   terme source reparti sur npasinject pas
-c   On injecte tous les traceurs de la meme facon
-      if (itau.le.npasinject) then
-        injecte='X'
-         do iq=iqmin,iqmax
-            print*,'INJECTION AU POINT ',lon_stat(iq),lat_stat(iq)
-     s      ,'     I,J=',i_stat(iq),j_stat(iq),jjp1-j_stat(iq)+1
-            q(i_stat(iq),j_stat(iq),1,iq)=
-     s      q(i_stat(iq),j_stat(iq),1,iq)
-     s      +intensite(iq)/masse(i_stat(iq),j_stat(iq),1)/npasinject
-         enddo
-         print*,'fin des injections'
-      endif
-c=======================================================================
-c   FIN DE LA PARTIE TERMES SOURCES
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Advection
-c   ----------
-
-c=======================================================================
-         do isplit=1,nsplit
-c=======================================================================
-CC MAF dans le cas du offline on ne fait pas la difference masse et massem
-            do iii=1,nsplit_dyn
-               do iq=1,nq
-                  CALL vlsplt(q(:,:,:,iq),2.,masse,w,pbaru,pbarv,dtdyn)
-               enddo
-
-c   mise à jour du champd de masse tenant compte de l'advection sur
-c   le pas de temps considere.
-
-            enddo
-
-            do iq=1,nq
-               write(str2,'(i2.2)') iq
-               if(mod(itau,1).eq.0) 
-     s         call diagadv(q(:,:,:,iq),masse,'Traceur '//str2)
-            enddo
-
-
-c-----------------------------------------------------------------------
-c   Physique  (lessivage dans phytrac maintenant) MAF
-c   ---------------------------------------------------------
-
-        if(physic) then
-         if(debut) then
-         latfi(1)=rlatu(1)*180./pi
-         lonfi(1)=0.
-         DO j=2,jjm
-            DO i=1,iim
-               latfi((j-2)*iim+1+i)= rlatu(j)*180./pi
-               lonfi((j-2)*iim+1+i)= rlonv(i)*180./pi
-            ENDDO
-         ENDDO
-         latfi(ngridmx)= rlatu(jjp1)*180./pi
-         lonfi(ngridmx)= 0.
-         endif
-
-c
-C Calcul de paprs et pplay et de temp
-c   -----------------------------------------------------------------
-c     .... paprs  definis aux (llm +1) interfaces des couches  ....
-c     .... pplay  definis aux (  llm )    milieux des couches  ....
-c   -----------------------------------------------------------------
-C
-      DO l = 1, llmp1
-        paprs( 1,l ) = p(1,1,l)
-        ig0 = 2
-          DO j = 2, jjm
-             DO i =1, iim
-              paprs( ig0,l ) = p(i,j,l)
-              ig0 = ig0 +1
-             ENDDO
-          ENDDO
-        paprs( ngridmx,l ) = p(1,jjp1,l)
-      ENDDO
-c
-      unskap   = 1./ kappa
-      DO l=1,llm
-
-         pksurcp     =  pk(1,1,l) / cpp
-         pplay(1,l)  =  preff * pksurcp ** unskap
-         tempfi(1,l)   =  teta(1,1,l) *  pksurcp
-         ig0         = 2
-
-         DO j = 2, jjm
-            DO i = 1, iim
-              pksurcp        = pk(i,j,l) / cpp
-              pplay(ig0,l)   = preff * pksurcp ** unskap
-              tempfi(ig0,l)    = teta(i,j,l)  * pksurcp
-              ig0            = ig0 + 1
-            ENDDO
-         ENDDO
-
-         pksurcp       = pk(1,jjp1,l) / cpp
-         pplay(ig0,l)  = preff * pksurcp ** unskap
-         tempfi (ig0,l)  = teta(1,jjp1,l)  * pksurcp
-      ENDDO
-c On passe le traceur et le geopot de surf  sur la grille physique
-             call gr_dyn_fi(llm*nq,iip1,jjp1,ngridmx,q,qfi)
-             call gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,pphis)
-
-             do iii=1,nsplit_phy
-C
-      print*,'dtphys avant phytrac ',dtphys
-             call phytrac(rnpb,
-     I                   ecritphy, debutphy,
-     I                   nq,
-     I                   ngridmx,llm,dtphys,
-     I                   tempfi,paprs,pplay,
-     I                   zmfu, zmfd, zen_u, zde_u, zen_d, zde_d,
-     I                   coefkz,yu1,yv1,ftsol,pctsrf,latfi,
-     I                   frac_impa, frac_nucl,
-     I                   lonfi,presnivs,airefi,pphis,
-     O                   qfi)
-C
-             debutphy= .FALSE.
-C
-             enddo ! nsplit_phy
-C
-c   On passe le traceur sur la grille dynamique.
-             call gr_fi_dyn(llm*nq,ngridmx,iip1,jjp1,qfi,q)
-
-             endif
-
-             itauav=(itau-1)*nsplit+isplit
-             CALL writedynav(histaveid, nq, itauav,vcov ,
-     ,                   ucov,teta,pk,phi,q,masse,ps,phis)
-
-         enddo ! isplit=1,nsplit
-
-         call histsync
-
-c-----------------------------------------------------------------------
-c    Calcul de ucov et vcov pour les sorties
-c   -------------------------------------
-
-         call massbar(masse, massebx, masseby )
-         do l=1,llm
-            do j=1,jjp1
-               do i=1,iip1
-               ucov(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)*cu(i,j)
-     s         /istdyn
-               enddo
-            enddo
-            do j=1,jjm
-               do i=1,iip1
-               vcov(i,j,l)=pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)*cv(i,j)
-     s         /istdyn
-               enddo
-            enddo
-         enddo
-
-         iday= dayref+itau/iday_step
-         time=
-     s   float(itau-(iday-dayref)*iday_step)/iday_step+time_0
-         IF(time.GT.1.) THEN
-            time = time-1.
-            iday = iday+1
-         ENDIF
-
-
-
-C
-c=======================================================================
-         if(irec.ge.recstkmin.and.irec.le.recstkmax) then
-            if (mod(itau,4).eq.0) then
-            stoke='X'
-               do iq=1,nq
-                  write(str2,'(i2.2)') iq
-                  nom='q'//str2
-                  call wrgrads(1,1,q(:,:,:,iq),nom,nom)
-                  call wrgrads(2,1,q(:,:,ldec,iq),nom,nom)
-               enddo
-            endif
-         endif
-
-         print*,'Record=',irec,'   stoke=',stoke,
-     s      '      injecte=',injecte
-
-      enddo ! itau
-
-      CALL dynredem1("restart.nc",0.0,
-     .          vcov,ucov,teta,q,nq,masse,ps)
-
-c=======================================================================
-C fermeture des fichiers netcdf
-          CALL histclo
-C
- 300  FORMAT('1',/,15x,'run du pas',i7,2x,'au pas',i7,2x,
-     s 'c"est a dire dujour',i7,3x,'au jour',i7,/,/)
-
-      end
-C----------------------------------------------------------------------
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/offlinenc.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/offlinenc.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/offlinenc.F	(revision 497)
@@ -0,0 +1,948 @@
+c
+c $Header$
+c
+      PROGRAM offlinenc
+      USE ioipsl
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissnew.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "control.h"
+#include "ener.h"
+#include "description.h"
+#include "serre.h"
+#include "tracstoke.h"
+      integer ngridmx,nbsrf
+      PARAMETER (ngridmx=iim*(jjm-1)+2,nbsrf=4)
+c-----------------------------------------------------------------------
+
+      INTEGER*4  iday ! jour julien
+      REAL       time ! Heure de la journee en fraction d'1 jour
+      REAL dtdyn,dtav
+      INTEGER iday_step
+
+      INTEGER         longcles
+      PARAMETER     ( longcles = 20 )
+      REAL  clesphy0( longcles )
+      logical clefinit
+
+c   variables dynamiques
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL q(iip1,jjp1,llm,nqmx)               ! champs advectes
+	real qmoy(iip1,jjp1,nqmx)
+      REAL pks(iip1,jjp1)                      ! exner (f pour filtre)
+      REAL phis(iip1,jjp1)                     ! geopotentiel au sol
+      REAL phi(iip1,jjp1,llm)                  ! geopotentiel
+      REAL w(iip1,jjp1,llm)                    ! vitesse verticale
+C
+C   variables physiques
+      real zmfd(ngridmx,llm),zde_d(ngridmx,llm),zen_d(ngridmx,llm)
+      REAL qfi(ngridmx,llm,nqmx)               ! champs advectes
+      real zmfu(ngridmx,llm),zde_u(ngridmx,llm),zen_u(ngridmx,llm)
+	real t(ngridmx,llm)
+      real coefkz(ngridmx,llm)
+      real frac_impa(ngridmx,llm),frac_nucl(ngridmx,llm)
+      real pphis (ngridmx)
+      REAL airefi(ngridmx)
+      REAL latfi(ngridmx),lonfi(ngridmx) ! latitude et long pour chaque point
+      real yu1(ngridmx), yv1(ngridmx)
+      real ftsol(ngridmx,nbsrf),pctsrf(ngridmx,nbsrf)
+C
+      character*10 file
+c variables dynamiques intermediaire pour le transport
+      REAL pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm) !flux de masse
+      REAL masse(iip1,jjp1,llm)
+      REAL massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
+      REAL teta(iip1,jjp1,llm)
+      INTEGER itau,irec,nrec,ldec,itauav
+      integer recmin,recmax,recstkmin,recstkmax
+      character*1 injecte,stoke
+      character*10 nom
+
+	real tinj2,tinj1
+	integer iiinj
+      integer jour0,isplit,nsplit_dyn,nsplit_phy,nsplit
+      logical debut,lectstart,rnpb,lafin
+
+      EXTERNAL inidissip,iniconst,inifilr
+      EXTERNAL inigeom
+      EXTERNAL exner_hyb,pression
+      EXTERNAL defrun_new
+
+      REAL time_0 ! temps de debut de simulation (% journee)
+
+      character*2 str2
+      INTEGER iq,j,i,l,nq,mode
+      real paprs(ngridmx,llm+1),pplay(ngridmx,llm),tempfi(ngridmx,llm)
+      real p(iip1,jjp1,llmp1),pk(iip1,jjp1,llm)
+      real lon_stat(nqmx),lat_stat(nqmx),zlon,zlat
+      integer i_stat(nqmx),j_stat(nqmx)
+      real intensite(nqmx)
+      integer iqmin,iqmax
+      integer npasinject
+      data npasinject/1/
+      integer histid, histvid, histaveid
+      real time_step, t_wrt, t_ops
+      integer itime_step
+      character*80 dynhist_file, dynhistave_file
+
+      logical avant
+      logical debutphy,redecoupage
+      DATA debutphy/.true./
+
+      real unskap,pksurcp,smass(iip1,jjp1)
+      integer ig0,ii,jj,iii,ij
+
+      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm)
+      REAL ps(iip1,jjp1),pkf(ip1jmp1,llm) 
+
+	integer ntau, iinjec2,iij
+	real zttt
+c-----------------------------------------------------------------------
+c   Initialisations:
+c   ----------------
+      descript = 'Run GCM LMDZ'
+	tinj1=0.
+	tinj2=0.
+      rad = 6400000
+      omeg = 7.272205e-05
+      g = 9.8
+      kappa = 0.285716
+      daysec = 86400
+      cpp = 1004.70885
+
+Cmaf a verifier....
+      preff = 101325.
+      pa= 50000.
+C
+      print*,'PARAMETRES A ENTRER DANS offline.def'
+      print*,'Nombre effectif de traceurs'
+      read(*,*) nq
+      write(*,*) nq
+      print*,'Splitting du pas de temps dynamique'
+      read(*,*) nsplit_dyn
+      write(*,*) nsplit_dyn
+      print*,'Splitting du pas de temps physique'
+      read(*,*) nsplit_phy
+      write(*,*) nsplit_phy
+      print*,'jour0, par rapport au debut du fichier fluxmass'
+      read(*,*) jour0
+      write(*,*) jour0
+      print*,'redecoupage (T) ou standard (F)'
+      read(*,'(l1)') redecoupage
+      write(*,*) redecoupage
+      print*,'Lecture fichier start (T)?'
+      read(*,'(l1)') lectstart
+      write(*,'(l1)') lectstart
+      print*,'Traceurs 1 et 2 = Rn222 et Pb'
+      read(*,'(l1)') rnpb
+      write(*,'(l1)') rnpb
+      print*,'Avant T ou arriere F?'
+      read(*,'(l1)') avant
+      write(*,'(l1)') avant
+      print*,'Index min et max des traceurs a initaliser'
+      read(*,*) iqmin,iqmax
+      write(*,*) iqmin,iqmax
+      print*,'localisation (lon, lat, intensite)'
+
+      if(iqmax.le.0) then
+         iqmin=iqmax+1
+      endif
+
+      do iq=iqmin,iqmax
+         read(*,*) lon_stat(iq),lat_stat(iq),intensite(iq)
+         write(*,*) lon_stat(iq),lat_stat(iq),intensite(iq)
+      enddo
+
+      print*,'Records min et max pour le stokage et couche '
+     s    ,'verticale (specifique reseaux), def 0 0 1'
+      read(*,*) recstkmin,recstkmax,ldec
+      write(*,*) recstkmin,recstkmax,ldec
+
+c   redefinition du splitting
+
+      if(mod(nsplit_dyn,nsplit_phy).eq.0) then
+         nsplit=nsplit_phy
+      elseif (mod(nsplit_phy,nsplit_dyn).eq.0) then
+         nsplit=nsplit_dyn
+      else
+         stop'prendre un des deux nsplit doit diviser l autre'
+      endif
+
+      nsplit_dyn=nsplit_dyn/nsplit
+      nsplit_phy=nsplit_phy/nsplit
+
+      print*,'nsplit,nsplit_dyn,nsplit_phy'
+     s       ,nsplit,nsplit_dyn,nsplit_phy
+
+c   Lecture eventuelle 
+      time_0=0.
+      if(nq.gt.nqmx) stop'surdimensioner nqmx'
+      print*,'av initial0'
+      call initial0(nq*ijp1llm,q)
+      print*,'av lectstart'
+
+      if(lectstart) then
+         CALL dynetat0("start.nc",nq,vcov,ucov,
+     .              teta,q,masse,ps,phis, time_0)
+         print*,'Lecture du start'
+c  On zappe le radon et le plomb.
+         q(:,:,:,1)=q(:,:,:,3)
+         q(:,:,:,2)=q(:,:,:,4)
+c Initialisation d'un traceur ` 1 pour tester l'impact du lessivage.
+         q(:,:,:,3)=1.
+      else
+         day_ini=0
+         annee_ref=0
+      endif
+
+      day_end=day_ini+nday
+C      print*,'av defrun'
+c     open (99,file='run.def',status='old',form='formatted')
+      clefinit=.true.
+      CALL defrun_new( 99, clefinit, clesphy0 )
+c     close(99)
+C      print*,'av iniconst'
+c   lecture du jour de demarrage
+c    premiere cnitialisation, eventuellement bidon
+      cALL iniconst
+      CALL inigeom
+C
+      print*,'ENTREE DANS redecoupenc ou lectfluxnc
+     s        pour irec=0'
+
+c  Lecture des entetes des fichiers de flux
+
+      if(redecoupage) then
+         call redecoupenc(0,masse,pbaru,pbarv,w,teta,phi,
+     s     nrec,avant,airefi,pphis,
+     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf,
+     s     frac_impa,frac_nucl,phis)
+      else
+         call lectfluxnc(0,masse,pbaru,pbarv,w,teta,phi,
+     s     nrec,avant,airefi,pphis,
+     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf,
+     s     frac_impa,frac_nucl,phis)
+         call inigeom
+      endif
+
+c   controle sur les records
+
+      if(avant) then
+         recmin=2+(jour0-1)*iday_step
+         recmax=1+(jour0+nday-1)*iday_step
+      else
+         recmin=(jour0-nday)*iday_step+2
+         recmax=jour0*iday_step+1
+      endif
+
+      if(recmin.le.1.or.recmax.ge.nrec) then
+         print*,'Probleme de lecture '
+         print*,'recmin,recmax,nrec',recmin,recmax,nrec
+         stop
+      endif
+
+C on recalcule le nombre de pas de temps dans une journee
+c   istdyn est la frequence de stokage en "pas de temps dynamique" dans
+c   le modele on-line. dtvr est le pas de temps du meme modele en s.
+c iday-step est le nombre de lectures par jour (grand pas de temps). 
+
+      iday_step=daysec/(istdyn*dtvr)
+C
+      CALL iniconst
+c  on calcule le pas de temps 
+      dtvr    = daysec/FLOAT(iday_step)
+      dtphys=dtvr/(nsplit*nsplit_phy) ! a mettre apres iniconst!
+      print*,'Pas de temps physique ',dtphys
+C
+      call gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
+      print *,'Pas de temps dynamique', dtvr
+      print*,'Pas de temps physique ',dtphys
+
+c-----------------------------------------------------------------------
+
+C maf est ce utile ?
+      call suphec
+      CALL inifilr
+      print*,'Pas de temps physique ',dtphys
+      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
+     *                tetagdiv, tetagrot , tetatemp              )
+      print*,'Pas de temps physique ',dtphys
+
+c-----------------------------------------------------------------------
+c   temps de depart et de fin:
+c   --------------------------
+      itau = 0
+      iday = dayref
+      time = time_0
+         IF(time.GT.1.) THEN
+          time = time-1.
+          iday = iday+1
+         ENDIF
+      print*,'Pas de temps physique ',dtphys
+c=======================================================================
+c   Initialisation des fichiers de sortie
+c=======================================================================
+      print*,'Initialisation de wrgras'
+	do i=1,iip1
+	print*,'rlonu(',i,')=',rlonu(i)
+	enddo
+	do i=1,jjp1
+	print*,'rlatu(',i,')=',rlatu(i)
+	enddo
+        do i=1,iip1
+        print*,'rlonv(',i,')=',rlonv(i)
+        enddo
+        do i=1,jjm
+        print*,'rlatv(',i,')=',rlatv(i)
+        enddo
+
+      file='sol'
+      call inigrads(1,iip1
+     s  ,rlonv,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,dtphys,file,'gcmq2 ')
+
+      file='atm'
+      print*,'Pas de temps physique ',dtphys
+      call inigrads(2,iip1
+     s  ,rlonv,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,dtphys,file,'gcmq2 ')
+
+      file='pbu'
+      call inigrads(3,iip1
+     s  ,rlonu,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,dtphys,file,'gcmq2 ')
+
+      file='pbv'
+      call inigrads(4,iip1
+     s  ,rlonv,180./pi,-180.,180.,jjm,rlatv,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,dtphys,file,'gcmq2 ')
+
+      file='qadv'
+      call inigrads(5,iip1
+     s  ,rlonv,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,dtphys,file,'gcmq2 ')
+
+      print*,'dtphys ap inigrads ',dtphys
+
+      print*,'Ecriture du fichier de conditions aux limites'
+      open (98,file='limit',form='unformatted')
+      write(98) float(im),float(jm),float(nq),float(nday)
+      write(98) (rlonv(i)*180./pi,i=1,iip1)
+      write(98) (rlatu(j)*180./pi,j=1,jjp1)
+      write(98) ((phis(i,j)/g,i=1,iip1),j=1,jjp1)
+      close(98)
+
+      CALL dynredem0("restart.nc",day_end,phis,nq)
+
+c-----------------------------------------------------------------------
+c   Debut de la boucle en temps:
+c   ----------------------------
+
+      do itau=1,nday*iday_step
+          print*,'ITAU ITAU ITAU =',itau
+         injecte='.'
+         stoke='.'
+c Gestion du temps
+         if (avant) then
+            dtdyn=dtvr/float(nsplit*nsplit_dyn)
+c            irec=1+(jour0-1)*iday_step+itau
+	     irec=(jour0-1)*iday_step+itau
+         else
+            dtdyn=-dtvr/float(nsplit*nsplit_dyn)
+            irec=1+jour0*iday_step-itau+1
+         endif
+
+         debut=itau.eq.1
+
+c-----------------------------------------------------------------------
+c   Lecture des fichiers fluxmass et physique:
+c   -----------------------------------------------------
+         print*,'CCCCC Appel a REDECOUPENC ou LECTFLUXNC
+     s           au pas itau=',itau
+      if(redecoupage) then
+         call redecoupenc(irec,masse,pbaru,pbarv,w,teta,phi,
+     s     nrec,avant,airefi,pphis,
+     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf, 
+     s     frac_impa,frac_nucl,phis)
+      else
+         call lectfluxnc(irec,masse,pbaru,pbarv,w,teta,phi,
+     s     nrec,avant,airefi,pphis,
+     s     t,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
+     s     yu1,yv1,ftsol,pctsrf, 
+     s     frac_impa,frac_nucl,phis)
+      endif
+
+
+      print*,'TESTPHYS: ON PREND LA PUIS ',1./float(nsplit*nsplit_phy)
+     s   ,'  DES FRAC A IT=',itau
+      frac_impa(:,:)=frac_impa(:,:)**(1./float(nsplit*nsplit_phy))
+      frac_nucl(:,:)=frac_nucl(:,:)**(1./float(nsplit*nsplit_phy))
+c    ...  ouverture du fichier de stockage netcdf ...
+C
+      IF (debut) then
+         dynhistave_file = 'histmoy.nc'
+         day_ini=0
+         annee_ref=0
+         t_ops =(1./48.)*daysec
+         t_wrt =(1./48.)*daysec
+         dtav=dtvr/float(nsplit)
+         mode=1
+
+c        CALL initdynav(dynhistave_file,day_ini,annee_ref,dtav,
+c    .              t_ops, t_wrt, nq,mode, histaveid)
+
+         pi=2.*asin(1.)
+         do iq=iqmin,iqmax
+            do l=1,llm
+               do j=1,jjp1
+                  do i=1,iip1
+                     q(i,j,l,iq)=0.
+                  enddo
+               enddo
+            enddo
+
+            zlon=lon_stat(iq)*pi/180.
+            zlat=lat_stat(iq)*pi/180.
+
+            CALL coordij(zlon,zlat,i_stat(iq),j_stat(iq))
+
+         enddo
+      ENDIF
+
+C calcul de la pression de surface.
+
+      do j=1,jjp1
+         do i=1,iip1
+            smass(i,j)=0.
+         enddo
+      enddo
+
+      do l=1,llm
+        do j=1,jjp1
+          do i=1,iip1
+             smass(i,j)=smass(i,j)+masse(i,j,l)
+          enddo
+       enddo
+      enddo
+
+      do j=1,jjp1
+         do i=1,iip1
+            ps (i,j)=smass(i,j)/aire(i,j)*g
+         end do
+      end do
+C
+C calcul de la pression et de pk (fonction d'Exner)
+C
+      CALL pression ( ip1jmp1, ap, bp, ps, p       )
+      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+C
+      do jj=1,jjp1
+         do ii=1,iip1
+           phis(ii,jj)= phi(ii,jj,1)-teta(ii,jj,1)*
+     s                             (pks(ii,jj)-pk(ii,jj,1))
+         end do
+      end do
+c=======================================================================
+c   TERMES SOURCES OU PUITS
+         do isplit=1,nsplit
+c=======================================================================
+c injection par Fred
+c	Print*,Verifier en fct de iapp_tracvl la boucle inj
+       goto 333
+c Inj pour le stokage ttes les 0.5h
+        if (itau.gt.32.and.itau.le.56)then
+        print*,'Masse de la maille inj :',
+     s          masse(i_stat(1),j_stat(1),1)
+	do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (float(nsplit)*24.*20.)
+
+        tinj1=tinj1+intensite(1)/(float(nsplit)*24.*20.)
+	enddo
+
+           print*,'Apres injection a itau ',itau
+
+            do iq=1,nq
+               write(str2,'(i2.2)') iq
+              call diagadv(q(:,:,:,iq),masse,'Traceur '//str2)
+            enddo
+
+        print*,'QT TOTALE INJECTEE TR1',tinj1
+        print*,'fin des injections'
+
+        endif
+
+c Inj pour le stokage ttes les 1h
+
+        if (itau.gt.16.and.itau.le.28)then
+        print*,'Masse de la maille inj :',
+     s          masse(i_stat(1),j_stat(1),1)
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (float(nsplit)*12.*20.)
+
+        tinj1=tinj1+intensite(1)/(float(nsplit)*12.*20.)
+
+        enddo
+
+           print*,'Apres injection a itau ',itau
+
+            do iq=1,nq
+               write(str2,'(i2.2)') iq
+              call diagadv(q(:,:,:,iq),masse,'Traceur '//str2)
+            enddo
+
+        print*,'QT TOTALE INJECTEE TR1',tinj1
+        print*,'fin des injections'
+
+        endif
+
+c Inj pour le stokage ttes les 1.5h
+
+        if (itau.eq.11.and.isplit.gt.2)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.ge.12.and.itau.le.18)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.eq.19.and.isplit.le.2)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+
+        endif
+
+c Inj pour le stokage ttes les 4h
+
+        if (itau.ge.5.and.itau.le.7)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+c Inj pour le stokage ttes les 3h
+
+        if (itau.eq.6.and.isplit.gt.2)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.ge.7.and.itau.le.9)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.eq.10.and.isplit.le.2)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+c  Inj pour le stokage ttes les 6h
+
+        if (itau.eq.3.and.isplit.gt.8)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.eq.4)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.eq.5.and.isplit.le.8)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+c Inj sur les 4 1ere couches pour le stokage ttes les 3h
+
+        if (itau.eq.6.and.isplit.gt.2)then
+	do l=1,4
+        q(i_stat(1),j_stat(1),l,1)=
+     s      q(i_stat(1),j_stat(1),l,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),l)/
+     s   (24.*4.)
+	enddo
+        endif
+
+        if (itau.ge.7.and.itau.le.9)then
+	do l=1,4
+        q(i_stat(1),j_stat(1),l,1)=
+     s      q(i_stat(1),j_stat(1),l,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),l)/
+     s   (24.*4.)
+	enddo
+        endif
+
+        if (itau.eq.10.and.isplit.le.2)then
+        do l=1,4
+        q(i_stat(1),j_stat(1),l,1)=
+     s      q(i_stat(1),j_stat(1),l,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),l)/
+     s   (24.*4.)
+        enddo
+        endif
+
+c Inj pour le stokage ttes les 12h
+
+	if (itau.eq.2.and.isplit.gt.8)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.eq.3.and.isplit.le.8)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+c Inj pour le stokage ttes les 24h
+
+        if (itau.eq.1.and.isplit.gt.32)then
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/24.
+        endif
+
+        if (itau.eq.2.and.isplit.le.8)then
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/24.
+        endif     
+
+c Inj pour le stokage ttes les 3h
+
+        if (itau.eq.6.and.isplit.gt.2)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.ge.7.and.itau.le.9)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+        if (itau.eq.10.and.isplit.le.2)then
+        do iiinj=1,20
+        q(i_stat(1),j_stat(1),1,1)=
+     s      q(i_stat(1),j_stat(1),1,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),1)/
+     s   (24.*20.)
+        enddo
+        endif
+
+333     continue
+
+        if (itau.eq.6.and.isplit.gt.2)then
+
+        do l=1,2
+        q(i_stat(1),j_stat(1),l,1)=
+     s      q(i_stat(1),j_stat(1),l,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),l)/
+     s   (24.*2.)
+        enddo
+        endif
+
+        if (itau.ge.7.and.itau.le.9)then
+        do l=1,2
+        q(i_stat(1),j_stat(1),l,1)=
+     s      q(i_stat(1),j_stat(1),l,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),l)/
+     s   (24.*2.)
+        enddo
+        endif
+
+        if (itau.eq.10.and.isplit.le.2)then
+        do l=1,2
+        q(i_stat(1),j_stat(1),l,1)=
+     s      q(i_stat(1),j_stat(1),l,1)
+     s  +intensite(1)/masse(i_stat(1),j_stat(1),l)/
+     s   (24.*2.)
+        enddo
+        endif
+
+c=======================================================================
+c   FIN DE LA PARTIE TERMES SOURCES
+c=======================================================================
+c-----------------------------------------------------------------------
+c   Advection
+c   ----------
+	print*,'ENTREE DANS VLSPLT'
+c=======================================================================
+c         do isplit=1,nsplit
+c=======================================================================
+CC MAF dans le cas du offline on ne fait pas la difference masse et massem
+            do iii=1,nsplit_dyn
+		  nom='pbaru'
+                  call wrgrads(3,llm,pbaru(:,:,1),nom,nom)
+                  nom='pbarv'
+                  call wrgrads(4,llm,pbarv(:,:,1),nom,nom)
+                  nom='masse'
+                  call wrgrads(3,llm,masse(:,:,1),nom,nom)
+                  nom='w'
+                  call wrgrads(3,llm,w(:,:,1),nom,nom)
+           print*,'Entree dans vlsplt a itau et au temps',itau,time
+	   print*,'Pas advect :',dtdyn
+           print*,'Avant vlsplt'
+            do iq=1,nq
+               write(str2,'(i2.2)') iq
+              call diagadv(q(:,:,:,iq),masse,'Traceur '//str2)
+            enddo
+               do iq=1,nq
+ctest abder   CALL vlsplt(q(1,1,1,iq),2.,masse,w,pbaru,pbarv,dtdyn)
+              CALL vlsplt(q(:,:,:,iq),2.,masse,w,pbaru,pbarv,dtdyn)
+               enddo
+
+               do iq=iqmin,iqmax
+                  write(str2,'(i2.2)') iq
+                  nom='q'//str2
+                  call wrgrads(5,1,q(:,:,1,iq),nom,nom)
+               enddo
+            print*,'Apres vlsplt'
+            do iq=1,nq
+               write(str2,'(i2.2)') iq
+              call diagadv(q(:,:,:,iq),masse,'Traceur '//str2)
+            enddo
+
+c   mise a jour du champ de masse tenant compte de l'advection sur
+c   le pas de temps considere.
+
+            enddo
+
+c-----------------------------------------------------------------------
+c   Physique  (lessivage dans phytrac maintenant) MAF
+c   ---------------------------------------------------------
+        if(physic) then
+         if(debut) then
+         latfi(1)=rlatu(1)*180./pi
+         lonfi(1)=0.
+         DO j=2,jjm
+            DO i=1,iim
+               latfi((j-2)*iim+1+i)= rlatu(j)*180./pi
+               lonfi((j-2)*iim+1+i)= rlonv(i)*180./pi
+            ENDDO
+         ENDDO
+         latfi(ngridmx)= rlatu(jjp1)*180./pi
+         lonfi(ngridmx)= 0.
+         endif
+c
+C Calcul de paprs et pplay et de temp
+c   -----------------------------------------------------------------
+c     .... paprs  definis aux (llm +1) interfaces des couches  ....
+c     .... pplay  definis aux (  llm )    milieux des couches  ....
+c   -----------------------------------------------------------------
+C
+      DO l = 1, llmp1
+        paprs( 1,l ) = p(1,1,l)
+        ig0 = 2
+          DO j = 2, jjm
+             DO i =1, iim
+              paprs( ig0,l ) = p(i,j,l)
+              ig0 = ig0 +1
+             ENDDO
+          ENDDO
+        paprs( ngridmx,l ) = p(1,jjp1,l)
+      ENDDO
+c
+      unskap   = 1./ kappa
+      DO l=1,llm
+         pksurcp     =  pk(1,1,l) / cpp
+         pplay(1,l)  =  preff * pksurcp ** unskap
+         tempfi(1,l)   =  teta(1,1,l) *  pksurcp
+         ig0         = 2
+         DO j = 2, jjm
+            DO i = 1, iim
+              pksurcp        = pk(i,j,l) / cpp
+              pplay(ig0,l)   = preff * pksurcp ** unskap
+              tempfi(ig0,l)    = teta(i,j,l)  * pksurcp
+              ig0            = ig0 + 1
+            ENDDO
+         ENDDO
+         pksurcp       = pk(1,jjp1,l) / cpp
+         pplay(ig0,l)  = preff * pksurcp ** unskap
+         tempfi (ig0,l)  = teta(1,jjp1,l)  * pksurcp
+      ENDDO
+
+c On passe le traceur et le geopot de surf  sur la grille physique
+             call gr_dyn_fi(llm*nq,iip1,jjp1,ngridmx,q,qfi)
+c             call gr_dyn_fi(1,iip1,jjp1,ngridmx,phis,pphis)
+             do iii=1,nsplit_phy
+C
+      lafin=.false. ! en attendant mieux.
+      print*,'dtphys avant phytrac ',dtphys
+      print*,'TESTPHYS: APPEL A PHYTRAC IT=',itau
+
+             call phytrac(rnpb,
+     I                   debutphy, lafin,
+     I                   nq,
+     I                   ngridmx,llm,dtphys,
+     I                   t,paprs,pplay,
+     I                   zmfu, zmfd, zen_u, zde_u, zen_d, zde_d,
+     I                   coefkz,yu1,yv1,ftsol,pctsrf,latfi,
+     I                   frac_impa, frac_nucl,
+     I                   lonfi,presnivs,airefi,pphis,
+     O                   qfi)
+C
+             debutphy= .FALSE.
+C
+             enddo ! nsplit_phy
+C
+c   On passe le traceur sur la grille dynamique.
+             call gr_fi_dyn(llm*nq,ngridmx,iip1,jjp1,qfi,q)
+
+             endif
+
+             itauav=(itau-1)*nsplit+isplit
+c             itauav=itau*nsplit+isplit
+c            CALL writedynav(histaveid, nq,mode, itauav,vcov ,
+c    ,                   ucov,teta,pk,phi,q,masse,ps,phis)
+c            qmoy(:,:,:)=qmoy(:,:,:)+q(:,:,1,:)
+         do iq=1,nq
+            do j=1,jjp1
+               do i=1,iip1
+                  qmoy(i,j,iq)=qmoy(i,j,iq)+q(i,j,1,iq)
+               enddo
+            enddo
+         enddo
+         enddo ! isplit=1,nsplit
+
+         call histsync
+
+c-----------------------------------------------------------------------
+c    Calcul de ucov et vcov pour les sorties
+c   -------------------------------------
+
+         call massbar(masse, massebx, masseby )
+         do l=1,llm
+            do j=1,jjp1
+               do i=1,iip1
+               ucov(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)*cu(i,j)
+     s         /istdyn
+               enddo
+            enddo
+
+            do j=1,jjm
+               do i=1,iip1
+               vcov(i,j,l)=pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)*cv(i,j)
+     s         /istdyn
+               enddo
+            enddo
+         enddo
+         iday= dayref+itau/iday_step
+         time=
+     s   float(itau-(iday-dayref)*iday_step)/iday_step+time_0
+         IF(time.GT.1.) THEN
+            time = time-1.
+            iday = iday+1
+         ENDIF
+C
+c=======================================================================
+               do iq=iqmin,iqmax
+                  write(str2,'(i2.2)') iq
+                  nom='q'//str2
+                  call wrgrads(1,1,qmoy(:,:,iq),nom,nom)
+                  call wrgrads(2,1,q(:,:,ldec,iq),nom,nom)
+               enddo
+
+         do iq=1,nq
+            do j=1,jjp1
+               do i=1,iip1
+                  qmoy(i,j,iq)=0.
+               enddo
+            enddo
+         enddo
+
+         print*,'Record=',irec,'   stoke=',stoke,
+     s      '      injecte=',injecte
+
+      enddo ! itau
+
+      CALL dynredem1("restart.nc",0.0,
+     .          vcov,ucov,teta,q,nq,masse,ps)
+
+c=======================================================================
+C fermeture des fichiers netcdf
+          CALL histclo
+C
+ 300  FORMAT('1',/,15x,'run du pas',i7,2x,'au pas',i7,2x,
+     s 'c"est a dire du jour',i7,3x,'au jour',i7,/,/)
+C----------------------------------------------------------------------
+
+      stop
+      end
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/ord_coord.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/ord_coord.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/ord_coord.F	(revision 497)
@@ -0,0 +1,92 @@
+       SUBROUTINE ord_coord ( nmax, xi, xo, decrois )
+
+c   .... Auteur :  P. Le Van  .... 
+c
+c   ... Reordonne eventuellement les coordonnees de la grille donnees ...
+c
+       IMPLICIT NONE
+
+c    .....  Arguments  en entree  .....
+
+       INTEGER nmax
+       REAL xi(nmax)
+
+c    .....  Arguments  en sortie  .....
+c
+       REAL xo(nmax+1) 
+       LOGICAL decrois
+
+c    .... Variables  locales  ....
+
+       REAL xscr(nmax)
+       INTEGER i,ii
+       REAL pi, degres, chmin, chmax, mult
+c
+
+       pi     = 2.*ASIN(1.)
+       degres = 180./pi
+       decrois = .FALSE.
+
+       DO i = 1, nmax 
+        xo(i) = xi(i)
+       ENDDO
+     
+       mult = 1.
+       IF( xo(1).GT.xo(nmax) ) mult = -1.
+
+       CALL minmax(nmax,xo(1),chmin,chmax)
+
+       IF(chmax.LT.6.5 )  THEN
+          DO i = 1,nmax
+           xo(i) = xo(i) * degres 
+          ENDDO
+       ENDIF
+
+       IF( ABS( xo( 1  ) + mult* 90. ). LT .0.001. OR .
+     ,     ABS( xo(nmax) - mult* 90. ). LT .0.001      )  THEN
+        PRINT *,' Reverifier les valeurs de  xidat  pour les donnees .'
+        PRINT *,' Elles doivent correspondre aux interfaces et non aux',
+     , 'ordonnees des donnees,egales a -90. et 90.deg aux 2 extremites '
+         CALL ABORT
+       ENDIF
+
+       IF( xo(1).GT.xo(nmax) )   THEN
+          DO i = 1, nmax 
+            xscr(i) = xo(i)
+          ENDDO
+          DO i = 1, nmax 
+            xo(i+1) = xscr(i)
+          ENDDO
+            xo (   1    ) =   90.
+       ELSE
+            xo ( nmax +1) =   90.
+       ENDIF
+
+       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
+
+       DO i = 3, nmax 
+
+        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
+         PRINT 1
+         PRINT 2,(xo(ii),ii=1,nmax)
+         CALL ABORT 
+        ENDIF
+        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
+         PRINT 1
+         PRINT 2,(xo(ii),ii=1,nmax)
+         CALL ABORT
+        ENDIF
+
+       ENDDO
+        
+       IF( decrois )  THEN
+c         CALL sort(nmax+1,xo(1))
+        CALL sort(nmax+1,xo)
+       ENDIF
+
+1      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
+     ,  'grille du modele ')
+2      FORMAT(1x,8f8.2)
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/ord_coordm.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/ord_coordm.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/ord_coordm.F	(revision 497)
@@ -0,0 +1,107 @@
+       SUBROUTINE ord_coordm ( nmax, xi, xo, jjm, jmods, decrois )
+
+c   ....  Auteur :  P. Le Van  .... 
+
+c   ... Reordonne eventuellement les coordonnees de la grille modele ...
+c
+       IMPLICIT NONE
+
+c    .....  Arguments  en entree  .....
+
+       INTEGER nmax,jjm
+       REAL xi(nmax)
+
+c    .....  Arguments  en sortie  .....
+c
+       REAL xo(nmax+1) 
+       LOGICAL decrois
+       INTEGER jmods
+
+c    .... Variables  locales  ....
+
+       REAL xscr(nmax)
+       INTEGER i
+       REAL pi, degres, chmin, chmax,mult
+c
+       DO i = 1, nmax 
+        xo(i) = xi(i)
+       ENDDO
+
+       mult = 1.
+       IF( xo(1).GT.xo(nmax) )  mult = - 1.
+       IF( nmax.EQ.jjm    ) jmods = nmax +1
+       IF( nmax.EQ.jjm +1 ) jmods = nmax -1 
+     
+       pi     = 2.*ASIN(1.)
+       degres = 180./pi
+       decrois = .FALSE.
+
+       CALL minmax(nmax,xo(1),chmin,chmax)
+
+       IF(chmax.LT.6.5 )  THEN
+          DO i = 1,nmax
+           xo(i) = xo(i) * degres 
+          ENDDO
+       ENDIF
+
+       IF( nmax.EQ.jjm )   THEN
+         IF( xo(1).GT.xo(nmax) )   THEN
+           DO i = 1, nmax 
+            xscr(i) = xo(i)
+           ENDDO
+           DO i = 1, nmax 
+            xo(i+1) = xscr(i)
+           ENDDO
+            xo (   1    ) =   90.
+         ELSE
+            xo ( nmax+1 ) =   90.
+         ENDIF
+       ELSE
+          IF( nmax.NE.jjm +1 )   THEN
+             PRINT *,'  Dans la routine ord_coordm , l argument nmax '
+             PRINT *,'  n est pas egal a jjm ni a jjm +1 . Corriger !'
+             CALL ABORT
+          ELSE
+            IF( ABS( xo(1)+ mult * 90.).GT.0.01 )  THEN
+              PRINT *,' Avec nmax =',nmax,'on devrait avoir des',
+     ,    ' ordonnees = 90. deg pour j=1 ou jjm+1 ! '
+             CALL ABORT
+            ELSE
+               IF( xo(1).LT.xo(nmax) )  THEN
+                 DO i = 1, nmax
+                  xscr(i) = xo(i)
+                 ENDDO
+                 DO i = 1, nmax -1
+                  xo(i) = xscr(i+1)
+                 ENDDO
+               ENDIF
+            ENDIF
+          ENDIF
+       ENDIF
+
+       IF ( xo(2).LT.xo(1) ) decrois =.TRUE.
+
+       DO i = 3, nmax 
+
+        IF(decrois.AND.xo(i).GT.xo(i-1) ) THEN
+         PRINT 1
+         CALL ABORT 
+        ENDIF
+        IF(.NOT.decrois.AND.xo(i).LT.xo(i-1) ) THEN
+         PRINT 1
+         CALL ABORT
+        ENDIF
+
+       ENDDO
+        
+       IF( decrois )  THEN
+         CALL sort(jmods,xo(1))
+       ENDIF
+
+
+1      FORMAT(5x,' Incoherence dans les valeurs des latitudes de la ',
+     ,  'grille du modele ')
+2      FORMAT(1x,8f8.2)
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/paramet.h
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/paramet.h	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/paramet.h	(revision 497)
@@ -7,5 +7,6 @@
       INTEGER jcfil,jcfllm
 
-      PARAMETER( iip1= iim+1, iip2= iim+2, iip3= iim+3, jjp1= jjm+1 )
+      PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3
+     s    ,jjp1=jjm+1-1/jjm)
       PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
       PARAMETER( kftd  = iim/2 -ndm )
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/physdem.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/physdem.F	(revision 3)
+++ 	(revision )
@@ -1,398 +1,0 @@
-      subroutine physdem(lonfi, latfi,phystep,radpas,co2_ppm,
-     .                   solaire, ts, ws, 
-     .                   sn, radsol, deltat, rugmer,
-     .                   agesno, zmea, zstd, zsig,
-     .                   zgam, zthe, zpic, zval,
-     .                   rugsrel)
-
-      IMPLICIT none
-c-------------------------------------------------------------
-C Author : L. Fairhead
-C Date   : 01/10/1999
-C Objet  : Ecriture des etats initiaux physiques
-c-------------------------------------------------------------
-c
-c
-c
-      INTEGER ivap
-      PARAMETER (ivap=1)
-c
-      REAL qsolmax
-      PARAMETER ( qsolmax = 150.0 )
-c
-#include "dimensions.h"
-#include "paramet.h"
-c-----------------------------------------------------------------------
-      INTEGER KIDIA, KFDIA, KLON, KLEV
-      PARAMETER (KIDIA=1,KFDIA=iim*(jjm-1)+2,
-     .           KLON=KFDIA-KIDIA+1,KLEV=llm)
-c-----------------------------------------------------------------------
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "control.h"
-#include "comdissnew.h"
-#include "logic.h"
-#include "ener.h"
-#include "netcdf.inc"
-c
-      INTEGER nid
-
-c Ajout de quelques parametres orographiques (F. LOTT janvier 1995)
-
-      REAL zmea(iip1,jjp1),zstd(iip1,jjp1)
-      REAL zsig(iip1,jjp1),zgam(iip1,jjp1),zthe(iip1,jjp1)
-      REAL zpic(iip1,jjp1),zval(iip1,jjp1)
-      REAL rugsrel(iip1,jjp1)
-      INTEGER idayref,anneeref
-
-
-      integer ierr, idim1, idim2, nvarid
-
-c
-      REAL phystep
-      INTEGER radpas
-      REAL co2_ppm
-      REAL solaire
-      REAL latfi(klon), lonfi(klon)
-      REAL champhys(klon)
-      REAL ts(klon)
-      REAL deltat(klon)
-      REAL ws(klon)
-      REAL sn(klon)
-      REAL radsol(klon)
-      REAL rugmer(klon)
-      REAL agesno(klon)
-      INTEGER length
-      PARAMETER (length=100)
-      REAL tab_cntrl(length)
-
-c
-
-      EXTERNAL defrun_new,iniconst,geopot,inigeom,massdair,pression
-      EXTERNAL exner_hyb , SSUM
-c
-#include "serre.h"
-#include "clesph0.h"
-#include "fxyprim.h"
-c-----------------------------------------------------------------------
-c
-c  stockage sur le fichier Physique:
-c
-      ierr = NF_CREATE("startphy.nc", NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        WRITE(6,*)' Pb d''ouverture du fichier startphy.nc'
-        WRITE(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
-     .                       "Fichier demmarage physique")
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim1)
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO ierr = 1, length
-         tab_cntrl(ierr) = 0.0
-      ENDDO
-      tab_cntrl(1)  = phystep
-      tab_cntrl(2)  = radpas
-      tab_cntrl(3)  = co2_ppm
-      tab_cntrl(4)  = solaire
-      tab_cntrl(5)  = iflag_con
-      tab_cntrl(6)  = nbapp_rad
-c
-cc     Modif ( P. Le Van )
-c
-       tab_cntrl( 7 ) = 0. 
-       tab_cntrl( 8 ) = 0. 
-       tab_cntrl( 9 ) = 0. 
-       tab_cntrl(10 ) = 0. 
-       tab_cntrl(11 ) = 0. 
-       tab_cntrl(12 ) = 0. 
-
-      IF(  cycle_diurne )  tab_cntrl( 7 ) = 1. 
-      IF(   soil_model  )  tab_cntrl( 8 ) = 1. 
-      IF(    new_oliq   )  tab_cntrl( 9 ) = 1. 
-      IF(    ok_orodr   )  tab_cntrl(10 ) = 1. 
-      IF(    ok_orolf   )  tab_cntrl(11 ) = 1. 
-      IF(  ok_limitvrai )  tab_cntrl(12 ) = 1. 
-
-      tab_cntrl(13)  = dayref
-      tab_cntrl(14)  = anneeref
-
-
-cc   ***    new_oliq   (  commentaires de L. LI dans routine physique ) 
-cc   ***  ok_orodr  et ok_orolf   si on appelle l'orographie      ****
-
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
-     .                        "Longitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,lonfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,lonfi)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
-     .                        "Latitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,latfi)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,latfi)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 25,
-     .                        "Temperature de la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ts)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ts)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "QS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "QS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
-     .                        "Humidite du sol")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ws)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,ws)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "SNOW", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "SNOW", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 5,
-     .                        "Neige")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sn)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,sn)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Rayonnement net a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "DELTAT", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 33,
-     .                        "Ecart de la SST (pour slab-ocean)")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,deltat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,deltat)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGMER", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Longueur de rugosite sur mer")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rugmer)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rugmer)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "AGESNO", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 15,
-     .                        "Age de la neige")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,agesno)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,agesno)
-#endif
-c
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zmea, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-c
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zstd, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zsig, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zgam, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zthe, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zpic, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, zval, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-
-      CALL gr_dyn_fi(1, iip1, jjp1, klon, rugsrel, champhys)
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RUGSREL", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,champhys)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,champhys)
-#endif
-c
-      ierr = NF_CLOSE(nid)
-
-      RETURN
-
-      END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/pres2lev.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/pres2lev.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/pres2lev.F	(revision 497)
@@ -0,0 +1,77 @@
+c $Header$
+c******************************************************
+      SUBROUTINE   pres2lev(varo,varn,lmo,lmn,po,pn,
+     %                      ni,nj)
+c
+c interpolation lineaire pour passer
+c a une nouvelle discretisation verticale pour
+c les variables de GCM
+c Francois Forget (01/1995)
+c 
+c MOdif remy roca 12/97 pour passer de pres2sig
+c**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       INTEGER lmo ! dimensions ancienne couches (input)
+       INTEGER lmn ! dimensions nouvelle couches (input)
+       INTEGER lmomx ! dimensions ancienne couches (input)
+       INTEGER lmnmx ! dimensions nouvelle couches (input)
+
+       parameter(lmomx=10000,lmnmx=10000)
+
+        real po(lmo)! niveau de pression en millibars
+        real pn(ni,nj,lmn) ! niveau de pression en pascals
+
+       INTEGER i,j,Nhoriz,ni,nj ! nombre de point horizontale (input)
+
+       REAL varo(ni,nj,lmo) ! var dans l'ancienne grille (input)
+       REAL varn(ni,nj,lmn) ! var dans la nouvelle grille (output)
+
+       real zvaro(lmomx),zpo(lmomx)
+
+c Autres variables
+c """"""""""""""""
+       INTEGER n, ln ,lo 
+       REAL coef
+
+c run
+c ====
+        do i=1,ni
+        do j=1,nj
+c a chaque point de grille correspond un nouveau sigma old
+c qui vaut pres(l)/ps(i,j)
+           do lo=1,lmo
+              zpo(lo)=po(lmo+1-lo)
+              zvaro(lo)=varo(i,j,lmo+1-lo)
+           enddo
+        
+           do ln=1,lmn
+              if (pn(i,j,ln).ge.zpo(1))then
+                 varn(i,j,ln) =  zvaro(1)
+              else if (pn(i,j,ln).le.zpo(lmo)) then
+                 varn(i,j,ln) =  zvaro(lmo)
+              else
+                 do lo=1,lmo-1 
+                    if ( (pn(i,j,ln).le.zpo(lo)).and.
+     &                 (pn(i,j,ln).gt.zpo(lo+1)) )then
+                       coef=(pn(i,j,ln)-zpo(lo))
+     &                 /(zpo(lo+1)-zpo(lo))
+                       varn(i,j,ln)=zvaro(lo)
+     &                 +coef*(zvaro(lo+1)-zvaro(lo))
+c       print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln)
+                    end if
+                 enddo           
+              endif
+           enddo
+
+        enddo
+        enddo
+      return
+      end    
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_dstoke.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_dstoke.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_dstoke.F	(revision 497)
@@ -0,0 +1,78 @@
+c $Header$
+            subroutine read_dstoke(irec,zdtvr,ziadvtrac,ziadvtrac2)
+
+
+            IMPLICIT NONE
+
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+
+	
+	integer ncidfd
+        save ncidfd
+        integer variddt,varididvt,varididvp
+        save variddt,varididvt,varididvp
+        real*4 dtv(1,1,1),adv2(1,1,1),adv(1,1,1)
+        real zdtvr,ziadvtrac,ziadvtrac2
+        integer status,irec
+        real rcode
+        INTEGER epais(2), debut(2)
+	
+	if (irec .eq. 0) then
+	
+	ncidfd=NCOPN('defstoke.nc',NCNOWRIT,rcode)
+
+        variddt=NCVID(ncidfd,'dtvr',rcode)
+        print*,'ncidfd,variddt',ncidfd,variddt
+
+        varididvt=NCVID(ncidfd,'istdyn',rcode)
+        print*,'ncidfd,varididvt',ncidfd,varididvt
+	
+	varididvp=NCVID(ncidfd,'istphy',rcode)
+        print*,'ncidfd,varididvp',ncidfd,varididvp
+
+c lecture de zdtvr et ziadvtrac
+	
+	epais(1) = 1
+        epais(2) = 1
+        debut(1) = 1
+        debut(2) = 1
+
+#ifdef NC_DOUBLE
+        status=NF_GET_VARA_DOUBLE(ncidfd,variddt,debut,epais,dtv)
+#else
+        status=NF_GET_VARA_REAL(ncidfd,variddt,debut,epais,dtv)
+#endif
+        zdtvr=dtv(1,1,1)
+
+#ifdef NC_DOUBLE
+        status=NF_GET_VARA_DOUBLE(ncidfd,varididvt,debut,epais,adv)
+#else
+        status=NF_GET_VARA_REAL(ncidfd,varididvt,debut,epais,adv)
+#endif
+        ziadvtrac= adv(1,1,1)
+	
+#ifdef NC_DOUBLE
+	status=NF_GET_VARA_DOUBLE(ncidfd,varididvp,debut,epais,adv2)
+#else
+	status=NF_GET_VARA_REAL(ncidfd,varididvp,debut,epais,adv2)
+#endif
+        ziadvtrac2= adv2(1,1,1)
+
+        write(*,*) 'ds read_dstoke zdtvr = ', zdtvr
+        write(*,*) 'ds read_dstoke ziadvtrac = ', ziadvtrac
+        write(*,*) 'ds read_dstoke ziadvtrac2 = ', ziadvtrac2
+	
+c           status=NF_CLOSE(ncidfd)
+
+        else
+            stop'Pas bon irec ne 0'
+	endif
+	
+	return
+
+	end
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_fstoke.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_fstoke.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_fstoke.F	(revision 497)
@@ -0,0 +1,297 @@
+c $Header$
+	subroutine read_fstoke(irec,
+     . zrec,zim,zjm,zlm,rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,
+     . airedy,phis,
+     . masse,pbaru,pbarv,w,teta,phi)
+
+	IMPLICIT NONE
+
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+	
+      integer nlevnc,irec
+      parameter (nlevnc=19)
+      integer mode,l
+
+	integer imo,jmo,imo1,jmo1,imn,jmn
+	parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2)
+        parameter (imo1=imo+1,jmo1=jmo+1)
+
+      real*4 pbaru(imo1,jmo1,llm),pbarv(imo1,jmo,llm)
+      real*4 teta(imo1,jmo1,llm),phis(imo1,jmo1),phi(imo1,jmo1,llm)
+      real*4 masse(imo1,jmo1,llm),w(imo1,jmo1,llm)
+      real*4 airedy(imo1,jmo1)
+      real*4 rlonu_dy(imo1,jmo1),rlonv_dy(imo1,jmo),
+     . rlatu_dy(imo1,jmo1),rlatv_dy(imo1,jmo)
+      integer*4 ncrec,ncim,ncjm,nclm
+      integer*4 zrec,zim,zjm,zlm
+      integer*4 xid,yid,zid,tid
+      real*4 zdtvr,ziadvtrac
+      real adv(1), dtv(1)
+
+      integer ncidf,ncidfv
+      integer varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
+      integer varidpl,varidm
+      integer varidnlo,varidnla,varidnlov,varidnlav
+      save ncidf,ncidfv
+      save varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
+      save varidpl,varidm
+      save varidnlo,varidnla,varidnlov,varidnlav
+
+      real*4 pl(nlevnc)
+
+      integer start(4),count(4),status
+
+      real rcode
+	
+      character namedim	
+	
+c ---------------------------------------------
+c   Initialisation de la lecture des fichiers
+c ---------------------------------------------
+
+      if (irec .eq. 0) then
+
+            ncidf=NCOPN('fluxstoke.nc',NCNOWRIT,rcode)
+
+            varidps=NCVID(ncidf,'phis',rcode)
+            print*,'ncidf,varidps',ncidf,varidps
+
+            varidpl=NCVID(ncidf,'sig_s',rcode)
+            print*,'ncidf,varidpl',ncidf,varidpl
+	
+	    varidnlo=NCVID(ncidf,'nav_lon',rcode)
+            print*,'ncidf,varidnlo',ncidf,varidnlo
+          
+            varidnla=NCVID(ncidf,'nav_lat',rcode)
+            print*,'ncidf,varidnla',ncidf,varidnla
+	
+            varidai=NCVID(ncidf,'aire',rcode)
+            print*,'ncidf,varidai',ncidf,varidai
+         
+            varidm=NCVID(ncidf,'masse',rcode)
+            print*,'ncidf,varidm',ncidf,varidm
+
+            varidpu=NCVID(ncidf,'pbaru',rcode)
+            print*,'ncidf,varidpu',ncidf,varidpu
+		
+            varidw=NCVID(ncidf,'w',rcode)
+            print*,'ncidf,varidw',ncidf,varidw
+	
+	    varidt=NCVID(ncidf,'teta',rcode)
+            print*,'ncidf,varidt',ncidf,varidt
+ 
+	    varidph=NCVID(ncidf,'phi',rcode)
+            print*,'ncidf,varidph',ncidf,varidph
+	
+	    ncidfv=NCOPN('fluxstokev.nc',NCNOWRIT,rcode)
+
+            varidpv=NCVID(ncidfv,'pbarv',rcode)
+            print*,'ncidfv,varidpv',ncidfv,varidpv
+	
+	    varidnlov=NCVID(ncidfv,'nav_lon',rcode)
+            print*,'ncidf,varidnlov',ncidf,varidnlov
+          
+            varidnlav=NCVID(ncidfv,'nav_lat',rcode)
+            print*,'ncidfv,varidnlav',ncidfv,varidnlav
+	
+
+c ID pour les dimensions
+	
+	    status = nf_inq_dimid(ncidf,'y',yid)
+            status = nf_inq_dimid(ncidf,'x',xid)
+            status = nf_inq_dimid(ncidf,'sig_s',zid) 
+            status = nf_inq_dimid(ncidf,'time_counter',tid)
+
+c lecture des dimensions
+	
+	    status = nf_inq_dim(ncidf,yid,namedim,ncjm)
+            status = nf_inq_dim(ncidf,xid,namedim,ncim)
+            status = nf_inq_dim(ncidf,zid,namedim,nclm)
+            status = nf_inq_dim(ncidf,tid,namedim,ncrec)
+	
+	    zjm=ncjm
+            zim=ncim
+            zlm=nclm
+            zrec=ncrec
+	
+	    write(*,*) 'read_fstoke : zrec = ', zrec
+            write(*,*) 'read_fstoke : zlm = ', zlm
+            write(*,*) 'read_fstoke : zim = ', zim
+            write(*,*) 'read_fstoke : zjm = ', zjm
+
+c niveaux de pression
+        
+#ifdef NC_DOUBLE
+       status=NF_GET_VARA_DOUBLE(ncidf,varidpl,1,zlm,pl)
+#else
+       status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl)
+#endif
+
+c rlonu,rlonv,rlatu,rlatv
+	
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=1
+      count(4)=0
+	
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidnlo,start,count,rlonu_dy)
+      status=NF_GET_VARA_DOUBLE(ncidf,varidnla,start,count,rlatu_dy)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy)
+      status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy)
+#endif
+	
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm-1
+      count(3)=1
+      count(4)=0
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlov,start,count,rlonv_dy)
+      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlav,start,count,rlatv_dy)
+#else
+      status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy)
+      status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy)
+#endif
+
+c Lecture de phis et aire
+	
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=1
+      count(4)=0
+
+c phis
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidps,start,count,phis)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis)
+#endif
+
+c aire
+#ifdef NC_DOUBLE
+       status=NF_GET_VARA_DOUBLE(ncidf,varidai,start,count,airedy)
+#else
+       status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy)
+#endif
+
+       else 
+
+      print*,'ok1'
+
+c ---------------------
+c   lecture des champs 
+c ---------------------
+
+      print*,'WARNING!!! Il n y a pas de test de coherence'
+      print*,'sur le nombre de niveaux verticaux dans le fichier nc'
+
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=irec
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=zlm
+      count(4)=1
+
+c masse 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidm,start,count,masse)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse)
+#endif
+c      print*,'WARNING!!! Correction bidon pour palier a un '
+c      print*,'probleme dans la creation des fichiers nc'
+c      call correctbid(iim,jmo1*nlevnc,masse)
+	print*,'***********Lecture MASSE '
+       call dump2d(imo1,jmo1,masse,'MASSE COUCHE 1')
+c pbaru 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidpu,start,count,pbaru)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru)
+#endif
+c      print*,'WARNING!!! Correction bidon pour palier a un '
+c      print*,'probleme dans la creation des fichiers nc'
+c      call correctbid(iim,jmo1*nlevnc,pbaru)
+c      call dump2d(imo1,jmo1,pbaru,'PBARUNC COUCHE 1')
+
+c w 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidw,start,count,w)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w)
+#endif
+c      print*,'WARNING!!! Correction bidon pour palier a un '
+c      print*,'probleme dans la creation des fichiers nc'
+c      call correctbid(iim,jmo1*nlevnc,w)
+c      call dump2d(imo1,jmo1,w,'WNC COUCHE 1')
+
+c teta 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidt,start,count,teta)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta)
+#endif
+c      print*,'WARNING!!! Correction bidon pour palier a un '
+c      print*,'probleme dans la creation des fichiers nc'
+c      call correctbid(iim,jmo1*nlevnc,teta)
+c      call dump2d(imo1,jmo1,teta,'TETANC COUCHE 1')
+
+c phi 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidph,start,count,phi)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi)
+#endif
+c      print*,'WARNING!!! Correction bidon pour palier a un '
+c      print*,'probleme dans la creation des fichiers nc'
+c      call correctbid(iim,jmo1*nlevnc,phi)
+c      call dump2d(imo1,jmo1,phi,'PHINC COUCHE 1')
+	
+	count(2) = zjm-1 
+
+c  pbarv
+	print*,'Lecture de pbarv irec=',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidfv,varidpv,start,count,pbarv)
+#else
+      status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv)
+#endif
+c      call correctbid(iim,jjm*nlevnc,pbarv)
+	PRINT*,'*******LECTURE DE PBARV******'
+      call dump2d(imo1,jjm,pbarv,'PBARVNC COUCHE 1')
+	print*,'Ok Lecture de pbarv irec=',irec
+      start(3)=irec
+      start(4)=0
+      count(2)=jmo1
+      count(3)=1
+      count(4)=0
+
+	endif
+	print*,'Fin read_fstoke a irec=',irec
+      return
+      end
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_fstoke0.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_fstoke0.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_fstoke0.F	(revision 497)
@@ -0,0 +1,269 @@
+c $Header$
+	subroutine read_fstoke0(irec,
+     . zrec,zim,zjm,zlm,rlonu_dy,rlonv_dy,rlatu_dy,rlatv_dy,
+     . airedy,phis,
+     . masse,pbaru,pbarv,w,teta,phi)
+
+	IMPLICIT NONE
+
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+	
+      integer nlevnc,irec
+      parameter (nlevnc=19)
+      integer mode,l
+
+      real*4 pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
+      real*4 teta(iip1,jjp1,llm),phis(iip1,jjp1),phi(iip1,jjp1,llm)
+      real*4 masse(iip1,jjp1,llm),w(iip1,jjp1,llm)
+      real*4 airedy(iip1,jjp1)
+      real*4 rlonu_dy(iip1,jjp1),rlonv_dy(iip1,jjm),
+     . rlatu_dy(iip1,jjp1),rlatv_dy(iip1,jjm)
+      integer*4 ncrec,ncim,ncjm,nclm
+      integer*4 zrec,zim,zjm,zlm
+      integer*4 xid,yid,zid,tid
+      real*4 zdtvr,ziadvtrac
+      real adv(1), dtv(1)
+
+      integer ncidf,ncidfv
+      integer varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
+      integer varidpl,varidm
+      integer varidnlo,varidnla,varidnlov,varidnlav
+      save ncidf,ncidfv
+      save varidpu,varidpv,varidt,varidw,varidps,varidph,varidai
+      save varidpl,varidm
+      save varidnlo,varidnla,varidnlov,varidnlav
+
+      real*4 pl(nlevnc)
+
+      integer start(4),count(4),status
+
+      real rcode
+	
+      character namedim	
+	
+c ---------------------------------------------
+c   Initialisation de la lecture des fichiers
+c ---------------------------------------------
+
+      if (irec .eq. 0) then
+
+            ncidf=NCOPN('fluxstoke.nc',NCNOWRIT,rcode)
+
+            varidps=NCVID(ncidf,'phis',rcode)
+            print*,'ncidf,varidps',ncidf,varidps
+
+            varidpl=NCVID(ncidf,'sig_s',rcode)
+            print*,'ncidf,varidpl',ncidf,varidpl
+	
+	    varidnlo=NCVID(ncidf,'nav_lon',rcode)
+            print*,'ncidf,varidnlo',ncidf,varidnlo
+          
+            varidnla=NCVID(ncidf,'nav_lat',rcode)
+            print*,'ncidf,varidnla',ncidf,varidnla
+	
+            varidai=NCVID(ncidf,'aire',rcode)
+            print*,'ncidf,varidai',ncidf,varidai
+         
+            varidm=NCVID(ncidf,'masse',rcode)
+            print*,'ncidf,varidm',ncidf,varidm
+
+            varidpu=NCVID(ncidf,'pbaru',rcode)
+            print*,'ncidf,varidpu',ncidf,varidpu
+		
+            varidw=NCVID(ncidf,'w',rcode)
+            print*,'ncidf,varidw',ncidf,varidw
+	
+	    varidt=NCVID(ncidf,'teta',rcode)
+            print*,'ncidf,varidt',ncidf,varidt
+ 
+	    varidph=NCVID(ncidf,'phi',rcode)
+            print*,'ncidf,varidph',ncidf,varidph
+	
+	    ncidfv=NCOPN('fluxstokev.nc',NCNOWRIT,rcode)
+
+            varidpv=NCVID(ncidfv,'pbarv',rcode)
+            print*,'ncidfv,varidpv',ncidfv,varidpv
+	
+	    varidnlov=NCVID(ncidfv,'nav_lon',rcode)
+            print*,'ncidf,varidnlov',ncidf,varidnlov
+          
+            varidnlav=NCVID(ncidfv,'nav_lat',rcode)
+            print*,'ncidfv,varidnlav',ncidfv,varidnlav
+	
+
+c ID pour les dimensions
+	
+	    status = nf_inq_dimid(ncidf,'y',yid)
+            status = nf_inq_dimid(ncidf,'x',xid)
+            status = nf_inq_dimid(ncidf,'sig_s',zid) 
+            status = nf_inq_dimid(ncidf,'time_counter',tid)
+
+c lecture des dimensions
+	
+	    status = nf_inq_dim(ncidf,yid,namedim,ncjm)
+            status = nf_inq_dim(ncidf,xid,namedim,ncim)
+            status = nf_inq_dim(ncidf,zid,namedim,nclm)
+            status = nf_inq_dim(ncidf,tid,namedim,ncrec)
+	
+	    zjm=ncjm
+            zim=ncim
+            zlm=nclm
+            zrec=ncrec
+	
+	    write(*,*) 'read_fstoke : zrec = ', zrec
+            write(*,*) 'read_fstoke : zlm = ', zlm
+            write(*,*) 'read_fstoke : zim = ', zim
+            write(*,*) 'read_fstoke : zjm = ', zjm
+
+c niveaux de pression
+        
+#ifdef NC_DOUBLE
+       status=NF_GET_VARA_DOUBLE(ncidf,varidpl,1,zlm,pl)
+#else
+       status=NF_GET_VARA_REAL(ncidf,varidpl,1,zlm,pl)
+#endif
+
+c rlonu,rlonv,rlatu,rlatv
+	
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=1
+      count(4)=0
+	
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidnlo,start,count,rlonu_dy)
+      status=NF_GET_VARA_DOUBLE(ncidf,varidnla,start,count,rlatu_dy)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidnlo,start,count,rlonu_dy)
+      status=NF_GET_VARA_REAL(ncidf,varidnla,start,count,rlatu_dy)
+#endif
+
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm-1
+      count(3)=1
+      count(4)=0
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlov,start,count,rlonv_dy)
+      status=NF_GET_VARA_DOUBLE(ncidfv,varidnlav,start,count,rlatv_dy)
+#else
+      status=NF_GET_VARA_REAL(ncidfv,varidnlov,start,count,rlonv_dy)
+      status=NF_GET_VARA_REAL(ncidfv,varidnlav,start,count,rlatv_dy)
+#endif
+
+c Lecture de phis et aire
+	
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=1
+      count(4)=0
+
+c phis
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidps,start,count,phis)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidps,start,count,phis)
+#endif
+
+c aire
+#ifdef NC_DOUBLE
+       status=NF_GET_VARA_DOUBLE(ncidf,varidai,start,count,airedy)
+#else
+       status=NF_GET_VARA_REAL(ncidf,varidai,start,count,airedy)
+#endif
+
+       else 
+
+      print*,'ok1'
+
+c ---------------------
+c   lecture des champs 
+c ---------------------
+
+      print*,'WARNING!!! Il n y a pas de test de coherence'
+      print*,'sur le nombre de niveaux verticaux dans le fichier nc'
+
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=irec
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=zlm
+      count(4)=1
+
+c masse 
+	PRINT*,'LECTURE DE masse'
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidm,start,count,masse)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidm,start,count,masse)
+#endif
+
+c pbaru 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidpu,start,count,pbaru)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidpu,start,count,pbaru)
+#endif
+
+c w 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidw,start,count,w)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidw,start,count,w)
+#endif
+
+c teta 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidt,start,count,teta)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidt,start,count,teta)
+#endif
+
+c phi 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidf,varidph,start,count,phi)
+#else
+      status=NF_GET_VARA_REAL(ncidf,varidph,start,count,phi)
+#endif
+	
+	count(2) = zjm-1 
+
+c  pbarv
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidfv,varidpv,start,count,pbarv)
+#else
+      status=NF_GET_VARA_REAL(ncidfv,varidpv,start,count,pbarv)
+#endif
+
+      start(3)=irec
+      start(4)=0
+      count(2)=jjp1
+      count(3)=1
+      count(4)=0
+
+	endif
+
+      return
+      end
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_pstoke.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_pstoke.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_pstoke.F	(revision 497)
@@ -0,0 +1,456 @@
+	subroutine read_pstoke0(irec,
+     .   zrec,zkon,zkev,airefi,phisfi,
+     .   t,mfu,mfd,en_u,de_u,en_d,de_d,coefh,
+     .   frac_impa,frac_nucl,pyu1,pyv1,ftsol,psrf)
+
+
+       IMPLICIT NONE
+
+#include "netcdf.inc"
+#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"
+	  
+	  integer*4 kon,kev,zkon,zkev
+	  parameter(kon=iim*(jjm-1)+2,kev=llm)
+	  REAL*4 phisfi(kon)
+          REAL*4 phisfi2(iim,jjm+1),airefi2(iim,jjm+1)
+
+          REAL*4 mfu(kon,kev), mfd(kon,kev)
+          REAL*4 en_u(kon,kev), de_u(kon,kev)
+          REAL*4 en_d(kon,kev), de_d(kon,kev)
+          REAL*4 coefh(kon,kev)
+		REAL*4 t(kon,kev)
+
+          REAL*4 mfu2(iim,jjm+1,kev), mfd2(iim,jjm+1,kev)
+          REAL*4 en_u2(iim,jjm+1,kev), de_u2(iim,jjm+1,kev)
+          REAL*4 en_d2(iim,jjm+1,kev), de_d2(iim,jjm+1,kev)
+          REAL*4 coefh2(iim,jjm+1,kev)
+		REAL*4 t2(iim,jjm+1,kev)
+
+          REAL*4 pl(kev)
+          integer irec
+          integer*4 xid,yid,zid,tid
+          integer*4 zrec,zim,zjm
+          integer*4 ncrec,nckon,nckev,ncim,ncjm
+
+          real*4 airefi(kon)
+          character namedim
+
+c  !! attention !!
+c attention il y a aussi le pb de def kon
+c dim de phis??
+
+          REAL*4 frac_impa(kon,kev), frac_nucl(kon,kev)
+          REAL*4 frac_impa2(iim,jjm+1,kev), 
+     .     frac_nucl2(iim,jjm+1,kev)
+          REAL*4 pyu1(kon), pyv1(kon)
+          REAL*4 pyu12(iim,jjm+1), pyv12(iim,jjm+1)
+          REAL*4 ftsol(kon,nbsrf)
+          REAL*4 psrf(kon,nbsrf) 
+	  REAL*4 ftsol1(kon),ftsol2(kon),ftsol3(kon),ftsol4(kon)
+          REAL*4 psrf1(kon),psrf2(kon),psrf3(kon),psrf4(kon)
+          REAL*4 ftsol12(iim,jjm+1),ftsol22(iim,jjm+1),
+     .     ftsol32(iim,jjm+1),
+     .     ftsol42(iim,jjm+1)
+          REAL*4 psrf12(iim,jjm+1),psrf22(iim,jjm+1),psrf32(iim,jjm+1),
+     .     psrf42(iim,jjm+1)
+	
+	  integer ncidp
+          save ncidp
+          integer varidmfu, varidmfd, varidps, varidenu, variddeu	
+		integer varidt
+          integer varidend,varidded,varidch,varidfi,varidfn
+          integer varidyu1,varidyv1,varidpl,varidai,varididvt
+          integer varidfts1,varidfts2,varidfts3,varidfts4
+          integer varidpsr1,varidpsr2,varidpsr3,varidpsr4
+          save varidmfu, varidmfd, varidps, varidenu, variddeu
+		save varidt
+          save varidend,varidded,varidch,varidfi,varidfn
+          save varidyu1,varidyv1,varidpl,varidai,varididvt
+          save varidfts1,varidfts2,varidfts3,varidfts4
+          save varidpsr1,varidpsr2,varidpsr3,varidpsr4
+
+          integer l, i
+          integer start(4),count(4),status
+          real rcode
+          logical first
+          save first
+          data first/.true./
+
+
+
+c ---------------------------------------------
+c   Initialisation de la lecture des fichiers
+c ---------------------------------------------
+
+      if (irec .eq. 0) then
+
+            ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
+
+            varidps=NCVID(ncidp,'phis',rcode)
+            print*,'ncidp,varidps',ncidp,varidps
+
+            varidpl=NCVID(ncidp,'sig_s',rcode)
+            print*,'ncidp,varidpl',ncidp,varidpl
+
+            varidai=NCVID(ncidp,'aire',rcode)
+            print*,'ncidp,varidai',ncidp,varidai
+
+            varidmfu=NCVID(ncidp,'mfu',rcode)
+            print*,'ncidp,varidmfu',ncidp,varidmfu
+
+		varidt=NCVID(ncidp,'t',rcode)
+                print*,'ncidp,varidt',ncidp,varidt
+
+            varidmfd=NCVID(ncidp,'mfd',rcode)
+            print*,'ncidp,varidmfd',ncidp,varidmfd
+
+            varidenu=NCVID(ncidp,'en_u',rcode)
+            print*,'ncidp,varidenu',ncidp,varidenu
+
+            variddeu=NCVID(ncidp,'de_u',rcode)
+            print*,'ncidp,variddeu',ncidp,variddeu
+
+            varidend=NCVID(ncidp,'en_d',rcode)
+            print*,'ncidp,varidend',ncidp,varidend
+	
+            varidded=NCVID(ncidp,'de_d',rcode)
+            print*,'ncidp,varidded',ncidp,varidded
+	
+            varidch=NCVID(ncidp,'coefh',rcode)
+            print*,'ncidp,varidch',ncidp,varidch
+	
+	    varidfi=NCVID(ncidp,'frac_impa',rcode)
+            print*,'ncidp,varidfi',ncidp,varidfi
+	
+	    varidfn=NCVID(ncidp,'frac_nucl',rcode)
+            print*,'ncidp,varidfn',ncidp,varidfn
+	
+            varidyu1=NCVID(ncidp,'pyu1',rcode)
+            print*,'ncidp,varidyu1',ncidp,varidyu1
+	
+            varidyv1=NCVID(ncidp,'pyv1',rcode)
+            print*,'ncidp,varidyv1',ncidp,varidyv1
+	
+            varidfts1=NCVID(ncidp,'ftsol1',rcode)
+            print*,'ncidp,varidfts1',ncidp,varidfts1
+	
+            varidfts2=NCVID(ncidp,'ftsol2',rcode)
+            print*,'ncidp,varidfts2',ncidp,varidfts2
+         
+            varidfts3=NCVID(ncidp,'ftsol3',rcode)
+            print*,'ncidp,varidfts3',ncidp,varidfts3
+  
+            varidfts4=NCVID(ncidp,'ftsol4',rcode)
+            print*,'ncidp,varidfts4',ncidp,varidfts4
+	
+            varidpsr1=NCVID(ncidp,'psrf1',rcode)
+            print*,'ncidp,varidpsr1',ncidp,varidpsr1
+	
+            varidpsr2=NCVID(ncidp,'psrf2',rcode)
+            print*,'ncidp,varidpsr2',ncidp,varidpsr2
+	
+	    varidpsr3=NCVID(ncidp,'psrf3',rcode)
+            print*,'ncidp,varidpsr3',ncidp,varidpsr3
+
+            varidpsr4=NCVID(ncidp,'psrf4',rcode)
+            print*,'ncidp,varidpsr4',ncidp,varidpsr4
+	
+c ID pour les dimensions
+
+            status = nf_inq_dimid(ncidp,'y',yid)
+            status = nf_inq_dimid(ncidp,'x',xid)
+            status = nf_inq_dimid(ncidp,'sig_s',zid)
+            status = nf_inq_dimid(ncidp,'time_counter',tid)
+
+c lecture des dimensions
+
+            status = nf_inq_dim(ncidp,yid,namedim,ncjm)
+            status = nf_inq_dim(ncidp,xid,namedim,ncim)
+            status = nf_inq_dim(ncidp,zid,namedim,nckev)
+            status = nf_inq_dim(ncidp,tid,namedim,ncrec)
+	
+            zrec=ncrec
+            zkev=nckev
+            zim=ncim
+            zjm=ncjm
+	
+	    zkon=zim*(zjm-2)+2
+	
+	    write(*,*) 'read_pstoke : zrec = ', zrec
+            write(*,*) 'read_pstoke : kev = ', zkev
+            write(*,*) 'read_pstoke : zim = ', zim 
+            write(*,*) 'read_pstoke : zjm = ', zjm
+            write(*,*) 'read_pstoke : kon = ', zkon
+
+c niveaux de pression
+
+#ifdef NC_DOUBLE
+            status=NF_GET_VARA_DOUBLE(ncidp,varidpl,1,kev,pl)
+#else
+            status=NF_GET_VARA_REAL(ncidp,varidpl,1,kev,pl)
+#endif
+
+c lecture de aire et phis
+	
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=0
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=1
+      count(4)=0
+
+c 
+c phis
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidps,start,count,phisfi2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidps,start,count,phisfi2)
+#endif
+
+
+      call gr_ecrit_fi(1,kon,iim,jjm+1,phisfi2,phisfi)
+
+c aire
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidai,start,count,airefi2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidai,start,count,airefi2)
+#endif
+
+      call gr_ecrit_fi(1,kon,iim,jjm+1,airefi2,airefi)
+      else
+
+      print*,'ok1'
+
+c ---------------------
+c   lecture des champs
+c ---------------------
+	
+	print*,'WARNING!!! Il n y a pas de test de coherence'
+        print*,'sur le nombre de niveaux verticaux dans le fichier nc'
+
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=irec
+
+      count(1)=zim
+      count(2)=zjm
+      count(3)=kev
+      count(4)=1
+
+c frac_impa 
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfi,start,count,frac_impa2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfi,start,count,frac_impa2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_impa2,frac_impa)
+
+c frac_nucl 
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfn,start,count,frac_nucl2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfn,start,count,frac_nucl2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,frac_nucl2,frac_nucl)
+
+c abder t
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidt,start,count,t2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidt,start,count,t2)
+#endif
+
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,t2,t)
+
+c mfu
+
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidmfu,start,count,mfu2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidmfu,start,count,mfu2)
+#endif
+
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfu2,mfu)
+
+c mfd
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidmfd,start,count,mfd2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidmfd,start,count,mfd2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,mfd2,mfd)
+
+c en_u 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidenu,start,count,en_u2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidenu,start,count,en_u2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_u2,en_u)
+
+c de_u 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,variddeu,start,count,de_u2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,variddeu,start,count,de_u2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_u2,de_u)
+
+c en_d 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidend,start,count,en_d2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidend,start,count,en_d2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,en_d2,en_d)
+
+c de_d 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidded,start,count,de_d2)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidded,start,count,de_d2)
+#endif
+      call gr_ecrit_fi(kev,kon,iim,jjm+1,de_d2,de_d)
+
+c coefh 
+	print*,'LECTURE de coefh a irec =',irec
+#ifdef NC_DOUBLE
+       status=NF_GET_VARA_DOUBLE(ncidp,varidch,start,count,coefh2)
+#else
+       status=NF_GET_VARA_REAL(ncidp,varidch,start,count,coefh2)
+#endif
+
+       call gr_ecrit_fi(kev,kon,iim,jjm+1,coefh2,coefh)
+
+      start(3)=irec
+      start(4)=0
+      count(3)=1
+      count(4)=0
+
+c pyu1
+	print*,'LECTURE de yu1 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidyu1,start,count,pyu12)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidyu1,start,count,pyu12)
+#endif
+
+      call gr_ecrit_fi(1,kon,iim,jjm+1,pyu12,pyu1)
+
+c pyv1
+        print*,'LECTURE de yv1 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidyv1,start,count,pyv12)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidyv1,start,count,pyv12)
+#endif
+      call gr_ecrit_fi(1,kon,iim,jjm+1,pyv12,pyv1)
+
+c ftsol1
+        print*,'LECTURE de ftsol1 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts1,start,count,ftsol12)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfts1,start,count,ftsol12)
+#endif
+       call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol12,ftsol1)
+
+c ftsol2
+        print*,'LECTURE de ftsol2 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts2,start,count,ftsol22)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfts2,start,count,ftsol22)
+#endif
+      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol22,ftsol2)
+
+c ftsol3
+	 print*,'LECTURE de ftsol3 a irec =',irec
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts3,start,count,ftsol32)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfts3,start,count,ftsol32)
+#endif
+      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol32,ftsol3)
+
+c ftsol4
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidfts4,start,count,ftsol42)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidfts4,start,count,ftsol42)
+#endif
+      call gr_ecrit_fi(1,kon,iim,jjm+1,ftsol42,ftsol4)
+
+c psrf1 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr1,start,count,psrf12)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidpsr1,start,count,psrf12)
+#endif
+c      call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
+      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf12,psrf1)
+
+c psrf2 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr2,start,count,psrf22)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidpsr2,start,count,psrf22)
+#endif
+c      call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
+      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf22,psrf2)
+
+c psrf3 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr3,start,count,psrf32)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidpsr3,start,count,psrf32)
+#endif
+      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf32,psrf3)
+
+c psrf4 
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidp,varidpsr4,start,count,psrf42)
+#else
+      status=NF_GET_VARA_REAL(ncidp,varidpsr4,start,count,psrf42)
+#endif
+      call gr_ecrit_fi(1,kon,iim,jjm+1,psrf42,psrf4)
+	
+          do i = 1,kon
+	
+	psrf(i,1) = psrf1(i)
+        psrf(i,2) = psrf2(i)
+        psrf(i,3) = psrf3(i)
+        psrf(i,4) = psrf4(i)
+  
+        ftsol(i,1) = ftsol1(i)
+        ftsol(i,2) = ftsol2(i)
+        ftsol(i,3) = ftsol3(i)
+        ftsol(i,4) = ftsol4(i)
+	
+          enddo
+	
+	endif
+	
+	return
+	
+	end
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_reanalyse.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_reanalyse.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/read_reanalyse.F	(revision 497)
@@ -0,0 +1,362 @@
+c
+c $Header$
+c
+      subroutine read_reanalyse(timestep,u,v,t,masse,ps,mode)
+
+c   mode=0 variables naturelles
+c   mode=1 variabels GCM
+
+      IMPLICIT NONE
+#include "netcdf.inc"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+#include "comvert.h"
+
+      integer nlevnc
+      parameter (nlevnc=15)
+C pour annee 2000      parameter (nlevnc=21)
+      integer timestep,mode,l
+
+      real u(iip1,jjp1,llm),v(iip1,jjm,llm)
+      real t(iip1,jjp1,llm),ps(iip1,jjp1)
+      real masse(iip1,jjp1,llm),pk(iip1,jjp1,llm)
+
+      integer ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps
+      integer varidpl
+      save ncidu,varidu,ncidv,varidv,ncidt,varidt,ncidps,varidps
+      save varidpl
+
+      real*4 unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)
+      real*4 tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)
+      real*4 pl(nlevnc)
+
+      integer start(4),count(4),status
+
+      real rcode
+      logical first,ncep
+      save first,ncep
+cMod 11 2 99
+       data first,ncep/.true.,.false./
+c      data first,ncep/.true.,.true./
+      print*,'ok0'
+c -----------------------------------------------------------------
+c   Initialisation de la lecture des fichiers
+c -----------------------------------------------------------------
+      if (first) then
+            ncidu=NCOPN('u.nc',NCNOWRIT,rcode)
+            varidu=NCVID(ncidu,'UWND',rcode)
+            print*,'ncidu,varidu',ncidu,varidu
+         if (ncep) then
+            varidpl=NCVID(ncidu,'LEVEL',rcode)
+         else
+            varidpl=NCVID(ncidu,'PRESSURE',rcode)
+         endif
+            print*,'ncidu,varidpl',ncidu,varidpl
+            ncidv=NCOPN('v.nc',NCNOWRIT,rcode)
+            varidv=NCVID(ncidv,'VWND',rcode)
+            print*,'ncidv,varidv',ncidv,varidv
+            ncidt=NCOPN('T.nc',NCNOWRIT,rcode)
+            varidt=NCVID(ncidt,'AIR',rcode)
+            print*,'ncidt,varidt',ncidt,varidt
+c           ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
+c           varidps=NCVID(ncidps,'SP',rcode)
+c           print*,'ncidps,varidps',ncidps,varidps
+      endif
+
+      print*,'ok1'
+c -----------------------------------------------------------------
+c   lecture des champs u, v, T, ps
+c -----------------------------------------------------------------
+
+c  niveaux de pression
+      print*,'WARNING!!! Il n y a pas de test de coherence'
+      print*,'sur le nombre de niveaux verticaux dans le fichier nc'
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidu,varidpl,1,nlevnc,pl)
+#else
+      status=NF_GET_VARA_REAL(ncidu,varidpl,1,nlevnc,pl)
+#endif
+      start(1)=1
+      start(2)=1
+      start(3)=1
+      start(4)=timestep
+
+      count(1)=iip1
+      count(2)=jjp1
+      count(3)=nlevnc
+      count(4)=1
+
+c  u
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unc)
+#else
+      status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unc)
+#endif
+      print*,'WARNING!!! Correction bidon pour palier a un '
+      print*,'probleme dans la creation des fichiers nc'
+      call correctbid(iim,jjp1*nlevnc,unc)
+c     call dump2d(iip1,jjp1,unc,'UNC COUCHE 1 ')
+c  T
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnc)
+#else
+      status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnc)
+#endif
+      call correctbid(iim,jjp1*nlevnc,tnc)
+c     call dump2d(iip1,jjp1,tnc,'TNC COUCHE 1 ')
+
+      count(2)=jjm
+c  v
+#ifdef NC_DOUBLE
+      status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnc)
+#else
+      status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnc)
+#endif
+      call correctbid(iim,jjm*nlevnc,vnc)
+c     call dump2d(iip1,jjm,vnc,'VNC COUCHE 1 ')
+
+      start(3)=timestep
+      start(4)=0
+      count(2)=jjp1
+      count(3)=1
+      count(4)=0
+c  ps
+C#ifdef NC_DOUBLE
+c     status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnc)
+C#else
+c     status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnc)
+C#endif
+c     call dump2d(iip1,jjp1,psnc,'PSNC COUCHE 1 ')
+c     call correctbid(iim,jjp1,psnc)
+
+c   Transformations
+      do l=1,nlevnc
+         pl(l)=pl(l)*100.
+      enddo
+      if(first) then
+         do l=1,nlevnc
+            print*,'PL(',l,')=',pl(l)
+         enddo
+      endif
+
+      call reanalyse2nat(nlevnc,unc,vnc,tnc,psnc,pl,u,v,t
+     s    ,ps,masse,pk)
+c     call dump2d(iip1,jjm,v,'V COUCHE 1 ')
+
+      if(mode.eq.1) call nat2gcm(u,v,t,pk,u,v,t)
+      print*,'TIMESTEP ',timestep
+      if(mode.ne.1) stop'mode pas egal 0'
+c     call dump2d(iip1,jjm,v,'VCOV COUCHE 1 ')
+
+c   Lignes introduites a une epoque pour un probleme oublie...
+c     do l=1,llm
+c        do i=1,iip1
+c           v(i,1,l)=0.
+c           v(i,jjm,l)=0.
+c        enddo
+c     enddo
+      first=.false.
+
+      return
+      end
+
+c -----------------------------------------------------------------
+      subroutine reanalyse2nat(nlevnc,unc,vnc,tnc,psnc,pl,u,v,t
+     s   ,ps,masse,pk)
+
+c -----------------------------------------------------------------
+c   Inversion Nord/sud de la grille + interpollation sur les niveaux
+c   verticaux du modele.
+c -----------------------------------------------------------------
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+#include "comvert.h"
+#include "comconst.h"
+
+      integer nlevnc
+      real u(iip1,jjp1,llm),v(iip1,jjm,llm)
+      real t(iip1,jjp1,llm),ps(iip1,jjp1)
+
+      real pl(nlevnc)
+      real unc(iip1,jjp1,nlevnc),vnc(iip1,jjm,nlevnc)
+      real tnc(iip1,jjp1,nlevnc),psnc(iip1,jjp1)
+
+      real zu(iip1,jjp1,llm),zv(iip1,jjm,llm)
+      real zt(iip1,jjp1,llm)
+
+      real pext(iip1,jjp1,llm)
+      real pbarx(iip1,jjp1,llm),pbary(iip1,jjm,llm)
+      real plunc(iip1,jjp1,llm),plvnc(iip1,jjm,llm)
+      real plsnc(iip1,jjp1,llm)
+
+      REAL alpha(iip1,jjp1,llm),beta(iip1,jjp1,llm)
+      real p(iip1,jjp1,llmp1),pk(iip1,jjp1,llm),pks(iip1,jjp1)
+      real pkf(iip1,jjp1,llm)
+      real masse(iip1,jjp1,llm),pls(iip1,jjp1,llm)
+      real prefkap,unskap
+
+      integer i,j,l
+
+
+c -----------------------------------------------------------------
+c   calcul de la pression au milieu des couches.
+c -----------------------------------------------------------------
+
+c     do j=1,jjp1
+c        do i=1,iim
+c           ps(i,j)=psnc(i,jjp1+1-j)
+c        enddo
+c        ps(iip1,j)=ps(1,j)
+c     enddo
+
+      CALL pression( ip1jmp1, ap, bp, ps, p )
+      call massdair(p,masse)
+      CALL exner_hyb(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
+c    ....  Calcul de pls , pression au milieu des couches ,en Pascals
+      unskap=1./kappa
+      prefkap =  preff  ** kappa
+c     PRINT *,' Pref kappa unskap  ',preff,kappa,unskap
+      DO l = 1, llm
+       DO j=1,jjp1
+        DO i =1, iip1
+        pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
+        ENDDO
+       ENDDO
+       ENDDO
+
+
+
+c -----------------------------------------------------------------
+c   calcul des pressions pour les grilles u et v
+c -----------------------------------------------------------------
+
+      do l=1,llm
+      do j=1,jjp1
+         do i=1,iip1
+            pext(i,j,l)=pls(i,j,l)*aire(i,j)
+         enddo
+      enddo
+      enddo
+      call massbar(pext, pbarx, pbary )
+      do l=1,llm
+      do j=1,jjp1
+         do i=1,iip1
+            plunc(i,jjp1+1-j,l)=pbarx(i,j,l)/aireu(i,j)
+            plsnc(i,jjp1+1-j,l)=pls(i,j,l)
+         enddo
+      enddo
+      enddo
+      do l=1,llm
+      do j=1,jjm
+         do i=1,iip1
+            plvnc(i,jjm+1-j,l)=pbary(i,j,l)/airev(i,j)
+         enddo
+      enddo
+      enddo
+
+c -----------------------------------------------------------------
+      call pres2lev(unc,zu,nlevnc,llm,pl,plunc,iip1,jjp1)
+      call pres2lev(vnc,zv,nlevnc,llm,pl,plvnc,iip1,jjm )
+      call pres2lev(tnc,zt,nlevnc,llm,pl,plsnc,iip1,jjp1)
+
+c     call dump2d(iip1,jjp1,ps,'PS    ')
+c     call dump2d(iip1,jjp1,psu,'PS    ')
+c     call dump2d(iip1,jjm,psv,'PS    ')
+c  Inversion Nord/Sud
+      do l=1,llm
+         do j=1,jjp1
+            do i=1,iim
+               u(i,j,l)=zu(i,jjp1+1-j,l)
+               t(i,j,l)=zt(i,jjp1+1-j,l)
+            enddo
+            u(iip1,j,l)=u(1,j,l)
+            t(iip1,j,l)=t(1,j,l)
+         enddo
+      enddo
+
+      do l=1,llm
+         do j=1,jjm
+            do i=1,iim
+               v(i,j,l)=zv(i,jjm+1-j,l)
+            enddo
+            v(iip1,j,l)=v(1,j,l)
+         enddo
+      enddo
+
+      return
+      end
+
+      subroutine nat2gcm(u,v,t,pk,ucov,vcov,teta)
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+#include "comconst.h"
+#include "comvert.h"
+
+      real u(iip1,jjp1,llm),v(iip1,jjm,llm)
+      real t(iip1,jjp1,llm),pk(iip1,jjp1,llm)
+
+      real ucov(iip1,jjp1,llm),vcov(iip1,jjm,llm)
+      real teta(iip1,jjp1,llm)
+
+      integer i,j,l
+
+
+c   calcul de ucov et de la temperature potentielle
+      do l=1,llm
+         do j=1,jjp1
+            do i=1,iim
+               ucov(i,j,l)=u(i,j,l)*cu(i,j)
+               teta(i,j,l)=t(i,j,l)*cpp/pk(i,j,l)
+            enddo
+            ucov(iip1,j,l)=ucov(1,j,l)
+            teta(iip1,j,l)=teta(1,j,l)
+         enddo
+         do i=1,iip1
+            ucov(i,1,l)=0.
+            ucov(i,jjp1,l)=0.
+            teta(i,1,l)=teta(1,1,l)
+            teta(i,jjp1,l)=teta(1,jjp1,l)
+         enddo
+      enddo
+
+c   calcul de ucov
+      do l=1,llm
+         do j=1,jjm
+            do i=1,iim
+               vcov(i,j,l)=v(i,j,l)*cv(i,j)
+            enddo
+            vcov(iip1,j,l)=vcov(1,j,l)
+         enddo
+      enddo
+
+c     call dump2d(iip1,jjp1,teta,'TETA EN BAS   ')
+c     call dump2d(iip1,jjp1,teta(1,1,llm),'TETA EN HAUT   ')
+
+      return
+      end
+      subroutine correctbid(iim,nl,x)
+      integer iim,nl
+      real x(iim+1,nl)
+      integer i,l
+      real zz
+
+      do l=1,nl
+         do i=2,iim-1
+            if(abs(x(i,l)).gt.1.e10) then
+               zz=0.5*(x(i-1,l)+x(i+1,l))
+c              print*,'correction ',i,l,x(i,l),zz
+               x(i,l)=zz
+            endif
+         enddo
+      enddo
+      return
+      end
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/redecoupe.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/redecoupe.F	(revision 3)
+++ 	(revision )
@@ -1,637 +1,0 @@
-      SUBROUTINE redecoupe(irec,massemn,pbarun,pbarvn,wn,tetan,phin,
-     s     nrec,avant,airefi,
-     s     zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkz,
-     s     yu1,yv1,ftsol,pctsrf,
-     s     frac_impa,frac_nucl,phisn)
-
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom2.h"
-
-#include "tracstoke.h"
-
-      integer irec,nrec,i,j
-
-      integer ig,l
-      integer imo,jmo,imn,jmn,ii,jj,ig
-      parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2)
-      integer ngrido,ngridn
-      parameter(ngrido=(jmo-1)*imo+2,ngridn=(jmn-1)*imn+2)
-
-
-      INTEGER nbsrf
-      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
-
-      real zmfd(ngridn,llm),zde_d(ngridn,llm),zen_d(ngridn,llm)
-      real zmfu(ngridn,llm),zde_u(ngridn,llm),zen_u(ngridn,llm)
-      real coefkz(ngridn,llm)
-      real frac_impa(ngridn,llm),frac_nucl(ngridn,llm)
-      real yu1(ngridn), yv1(ngridn)
-      real ftsol(ngridn,nbsrf),pctsrf(ngridn,nbsrf)
-      integer imfu,imfd,ien_u,ide_u,
-     s      ien_d,ide_d,
-     s      icoefkz,izu1,izv1,
-     s      itsol,ipsf,
-     s      ilei, ilec
-      parameter(imfu=1,imfd=llm+1,ien_u=2*llm+1,ide_u=3*llm+1,
-     s      ien_d=4*llm+1,ide_d=5*llm+1,
-     s      icoefkz=6*llm+1,
-     s      ilei=7*llm+1,ilec=8*llm+1,
-     s      izu1=9*llm+1,izv1=9*llm+2,
-     s      itsol=9*llm+3,ipsf=9*llm+3+nbsrf)
-      logical avant
-
-
-      real massefi(ngridn,llm)
-
-      real massemn(imn+1,jmn+1,llm),tetan(imn+1,jmn+1,llm)
-      real pbarun(imn+1,jmn+1,llm),pbarvn(imn+1,jmn,llm)
-      real wn(imn+1,jmn+1,llm),phin(imn+1,jmn+1,llm)
-      real phisn(imn+1,jmn+1)
-
-      real massemo(imo+1,jmo+1,llm),tetao(imo+1,jmo+1,llm)
-      real pbaruo(imo+1,jmo+1,llm),pbarvo(imo+1,jmo,llm)
-      real wo(imo+1,jmo+1,llm),phio(imo+1,jmo+1,llm)
-      real phiso(imo+1,jmo+1)
-
-      real pbarvst(imo+1,jmo+1,llm)
-
-      real airefi(ngridn)
-
-      real xlecn(ngridn,9*llm+2+2*nbsrf),tmpn(imn+1,jmn+1)
-      real xleco(ngrido,9*llm+2+2*nbsrf),tmpo(imo+1,jmo+1)
-
-      real zcontrole(ngridn),zmass,tmpdyn(imn+1,jmn+1),zflux
-
-      real ziadvtrac,zrec,ziadvtrac2,zrec2
-      real zim,zjm,zlm,zklon,zklev
-
-      real zpi
-c  longitudes et latitudes lues
-      real rlonul(1:imo+1),rlatvl(1:jmo)
-      real rlonvl(1:imo+1),rlatul(1:jmo+1)
-c  longitudes et latitudes anciennes
-      real rlonuo(0:imo+1),rlatvo(0:jmo+1)
-c  longitudes et latitudes nouvelles
-      real rlonun(0:imn+1),rlatvn(0:jmn+1)
-      real aireo(imo+1,jmo+1)
-
-      integer ndecx(imo+1),ndecy(jmo+1)
-      real alphax(imn+1),alphay(jmn+1)
-      real alphaxo(imo+1)
-      real alpha(imn+1,jmn+1)
-
-      real aa,uu(0:imo+1),vv(imo+1,0:jmo+1)
-
-
-      integer iest(imo+1),iouest(imo+1)
-      integer jsud(jmo+1),jnord(jmo+1)
-
-      integer in,io,jn,jo,l,iin,jjn
-      integer i,j
-      real dlatm,dlatp,dlonm,dlonp
-
-
-      zpi=2.*asin(1.)
-
-
-c==================================================================
-c   Si le numero du record est 0 alors: INITIALISATION
-c==================================================================
-c
-      print*,'ENTREE DANS LECTFLUX'
-        print*,'IREC=',IREC
-      if(irec.eq.0) then
-
-        print*,'IREC==',0
-
-C test         call inigeom
-c==================================================================
-c   Definition des surdecoupages dans les deux directions
-c==================================================================
-
-      ndecx(1)=1
-      do io=2,imo
-         ndecx(io)=2
-      enddo
-      ndecx(imo+1)=1
-
-      ndecy(1)=1
-      do jo=2,jmo
-         ndecy(jo)=2
-      enddo
-      ndecy(jmo+1)=1
-
-      ii=0
-      do io=1,imo+1
-         ii=ii+ndecx(io)
-      enddo
-      if(ii.ne.iim) then
-         print*,'ii=',ii,'   iim=',iim
-         stop
-      endif
-
-      jj=0
-      do jo=1,jmo+1
-         jj=jj+ndecy(jo)
-      enddo
-      if(jj.ne.jjp1) then
-         print*,'jj=',jj,'   jjm=',jjm
-         stop
-      endif
-
-c==================================================================
-c   Calcul des jsud,... correspondant aux intersections des
-c   grilles.
-c==================================================================
-
-      iest(1)=0
-      do io=2,imo+1
-         iest(io)=iest(io-1)+ndecx(io-1)
-         iouest(io-1)=iest(io)
-      enddo
-      iouest(imo+1)=iest(imo+1)+ndecx(imo+1)
-
-      jnord(1)=0
-      do jo=2,jmo+1
-         jnord(jo)=jnord(jo-1)+ndecy(jo-1)
-         jsud(jo-1)=jnord(jo)
-      enddo
-      jsud(jmo+1)=jnord(jmo+1)+ndecy(jmo+1)
-
-c==================================================================
-c   ouverture des fichiers, lecture des entetes
-c==================================================================
-
-c   Fichier fluxmass
-#ifdef CRAY
-         CALL ASSIGN("assign -N ieee -F null f:fluxmass")
-#endif
-      open(47,file='fluxmass',form='unformatted',
-     s     access='direct'
-     s     ,recl=4*6*(imo+1)*(jmo+1)*llm)
-      read(47,rec=1) zrec,dtvr,ziadvtrac,zim,zjm,zlm
-     s   ,rlonul,rlonvl,rlatul,rlatvl,aireo
-     s    ,phiso
-
-      print*,'zrec,dtvr,ziadvtrac,zim,zjm,zlm'
-      print*,zrec,dtvr,ziadvtrac,zim,zjm,zlm
-      if((imo-nint(zim))*(jmo-nint(zjm)).ne.0) then
-        print*,'Modifier les dimensions dans redecoupe '
-        print*,'Mettre imo=',zim,'   jmo=',zjm
-        stop
-      endif
-
-
-c  Fichier physique
-c  Fichier lessivage (supprime les donnees utiles sont dans "physique")
-#ifdef CRAY
-         CALL ASSIGN("assign -N ieee -F null f:physique")
-#endif
-      open(49,file='physique',form='unformatted',
-     s     access='direct'
-     s     ,recl=4*ngrido*(9*llm+2+2*nbsrf))
-      read(49,rec=1) zrec2,ziadvtrac2,zklon,zklev
-      print*,'Entete du fichier physique'
-      print*,zrec2,ziadvtrac2,zklon,zklev
-
-      nrec=zrec
-      istdyn=ziadvtrac
-      istphy=ziadvtrac2
-
-c==================================================================
-c   Definition des anciennes latitudes et longitudes
-c   (qui pourraient etre relues plus tard)
-c==================================================================
-
-      rlonuo(0)=-zpi
-      do io=1,imo
-c        rlonuo(io)=2.*zpi/FLOAT(imo)*(io+0.5-0.5*FLOAT(imo)-1.)
-c        print*,'LON ',io,rlonuo(io),rlonul(io)
-         rlonuo(io)=rlonul(io)
-      enddo
-      rlonuo(imo+1)=zpi
-
-      rlatvo(0)=zpi/2.
-      do jo=1,jmo
-c        rlatvo(jo)=zpi/FLOAT(jmo)*(0.5*FLOAT(jmo)+1.-jo-0.5)
-c        print*,'LAT ',jo,rlatvo(jo),rlatvl(jo)
-         rlatvo(jo)=rlatvl(jo)
-      enddo
-      rlatvo(jmo+1)=-zpi/2.
-
-c     do jo=1,jmo+1
-c        do io=1,imo+1
-c           aireo(io,jo)=rad*rad
-c    s         *(rlonuo(io)-rlonuo(io-1))
-c    s         *(sin(rlatvo(jo-1))-sin(rlatvo(jo)))
-c           aireo(io,jo)=airel(io,jo)
-c        enddo
-c        aireo(1,jo)=aireo(1,jo)+aireo(imo+1,jo)
-c        aireo(imo+1,jo)=aireo(1,jo)
-c     enddo
-
-      do io=2,imo
-         alphaxo(io)=1.
-      enddo
-      alphaxo(1)=(rlonuo(1)-rlonuo(0))
-     s        /(rlonuo(1)-rlonuo(0)+rlonuo(imo+1)-rlonuo(imo))
-      alphaxo(imo+1)=1.-alphaxo(1)
-
-c==================================================================
-c    Definition des nouvelles latitudes et longitudes
-c==================================================================
-
-      rlonun(0)=-zpi
-      do io=1,imo+1
-         do iin=1,iouest(io)-iest(io)
-            in=iin+iest(io)
-            rlonun(in)=
-     s      rlonuo(io-1)+iin*(rlonuo(io)-rlonuo(io-1))
-     s      /ndecx(io)
-            alphax(in)=alphaxo(io)/ndecx(io)
-            print787,io,rlonuo(io-1)*180./zpi,in
-     s      ,iest(io),iouest(io),rlonun(in)*180./zpi,alphax(in)
-         enddo
-      enddo
-
-      rlatvn(0)=0.5*zpi
-      do jo=1,jmo+1
-         print*,'jo=',jo
-         do jjn=1,jsud(jo)-jnord(jo)
-            jn=jnord(jo)+jjn
-            rlatvn(jn)=rlatvo(jo-1)+jjn*(rlatvo(jo)-rlatvo(jo-1))
-     s      /ndecy(jo)
-            alphay(jn)=(sin(rlatvn(jn-1))-sin(rlatvn(jn)))
-     s                /(sin(rlatvo(jo-1))-sin(rlatvo(jo)))
-            print787,jo,rlatvo(jo-1)*180./zpi,jn
-     s      ,jnord(jo),jsud(jo),rlatvn(jn)*180./zpi,alphay(jn)
-         enddo
-      enddo
-
-787   format(i5,f10.2,3(i5),2(f10.2))
-      do in=1,imn
-         rlonu(in)=rlonun(in)
-         rlonv(in)=0.5*(rlonun(in)+rlonun(in-1))
-      enddo
-      rlonv(imn+1)=rlonv(1)+2.*zpi
-      rlonu(imn+1)=rlonu(1)+2.*zpi
-
-      do jn=1,jmn
-         rlatv(jn)=rlatvn(jn)
-      enddo
-      do jn=1,jmn+1
-         rlatu(jn)=0.5*(rlatvn(jn-1)+rlatvn(jn))
-      enddo
-
-      do jn=1,jmn+1
-         do in=1,imn
-            alpha(in,jn)=alphax(in)*alphay(jn)
-         enddo
-         alpha(imn+1,jn)=0.
-      enddo
-
-c     call dump2d(iip1,jjp1,alpha,'ALPHA   ')
-
-c      .  on a :  cu(i,j) = rad * COS(y) * dx/dX         .
-c      .          cv( j ) = rad          * dy/dY         .
-c   A 1 point scalaire P (i,j) de la grille, reguliere en (X,Y) , sont
-c   affectees 4 aires entourant P , calculees respectivement aux points
-c            ( i + 1/4, j - 1/4 )    :    aireij1 (i,j)
-c            ( i + 1/4, j + 1/4 )    :    aireij2 (i,j)
-c            ( i - 1/4, j + 1/4 )    :    aireij3 (i,j)
-c            ( i - 1/4, j - 1/4 )    :    aireij4 (i,j)
-c
-c                             . V
-c
-c                 aireij4 .        . aireij1
-c
-c                   U .       . P      . U
-c
-c                 aireij3 .        . aireij2
-c
-c                             . V
-
-
-      do j=1,jjp1
-         do i=1,iim
-            dlonp=rlonun(i)-rlonv(i)
-            dlonm=rlonv(i)-rlonun(i-1)
-            dlatp=sin(rlatvn(j-1))-sin(rlatu(j))
-            dlatm=sin(rlatu(j))-sin(rlatvn(j))
-            aireij1 ( i,j ) = rad*rad*dlatp*dlonp
-            aireij2 ( i,j ) = rad*rad*dlatm*dlonp
-            aireij3 ( i,j ) = rad*rad*dlatm*dlonm
-            aireij4 ( i,j ) = rad*rad*dlatp*dlonm
-      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
-     *                          aireij4(i,j)
-      alpha1  ( i,j )  = aireij1(i,j) / aire(i,j)
-      alpha2  ( i,j )  = aireij2(i,j) / aire(i,j)
-      alpha3  ( i,j )  = aireij3(i,j) / aire(i,j)
-      alpha4  ( i,j )  = aireij4(i,j) / aire(i,j)
-      alpha1p2( i,j )  = alpha1 (i,j) + alpha2 (i,j)
-      alpha1p4( i,j )  = alpha1 (i,j) + alpha4 (i,j)
-      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
-      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
-           enddo
-           aireij1(iip1,j)=aireij1(1,j)
-           aireij2(iip1,j)=aireij2(1,j)
-           aireij3(iip1,j)=aireij3(1,j)
-           aireij4(iip1,j)=aireij4(1,j)
-           aire(iip1,j)=aire(1,j)
-           alpha1(iip1,j)=alpha1(1,j)
-           alpha2(iip1,j)=alpha2(1,j)
-           alpha3(iip1,j)=alpha3(1,j)
-           alpha4(iip1,j)=alpha4(1,j)
-           alpha1p2(iip1,j)=alpha1p2(1,j)
-           alpha1p4(iip1,j)=alpha1p4(1,j)
-           alpha2p3(iip1,j)=alpha2p3(1,j)
-           alpha3p4(iip1,j)=alpha3p4(1,j)
-       enddo
-c     call dump2d(iip1,jjp1,aire,'AIRE   ')
-
-c     do jn=1,jjp1
-c        do in=1,iim
-c           aire(in,jn)=rad*rad*(sin(rlatvn(jn-1))-sin(rlatvn(jn)))
-c    s      *(rlonun(in)-rlonun(in-1))
-c           unsaire(in,jn)=1./aire(in,jn)
-c        enddo
-c        aire(iip1,jn)=aire(1,jn)
-c        unsaire(iip1,jn)=unsaire(1,jn)
-c     enddo
-c     call dump2d(iip1,jjp1,aire,'AIRE2   ')
-      DO 42 j = 1,jjp1
-      DO 41 i = 1,iim
-      unsaire(i,j) = 1./ aire(i,j)
-      aireu  (i,j) = aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
-     *                           aireij3(i+1,j)
-  41  CONTINUE
-      aireu  (iip1,j) = aireu  (1,j)
-      unsaire(iip1,j) = unsaire(1,j)
-  42  CONTINUE
-      DO 48 j = 1,jjm
-        DO i=1,iim
-         airev(i,j)     = aireij2(i,j)+ aireij3(i,j)+ aireij1(i,j+1) +
-     *                           aireij4(i,j+1)
-        ENDDO
-       airev   (iip1,j) = airev(1,j)
-  48  CONTINUE
-      apoln=0.
-      apols=0.
-      do i=1,iim
-         apoln=apoln+aire(i,1)
-         apols=apols+aire(i,jjp1)
-      enddo
-
-
-
-      do jn=1,jjp1
-         do in=1,iim
-            cu(in,jn)=rad*cos(rlatu(jn))*(rlonv(in+1)-rlonv(in))
-         enddo
-         cu(iip1,jn)=cu(1,jn)
-      enddo
-      do jn=1,jjm
-         do in=1,iim+1
-            cv(in,jn)=rad*(rlatu(jn)-rlatu(jn+1))
-         enddo
-      enddo
-
-
-c==================================================================
-c   Fin des initialisations
-      else ! irec=0
-c==================================================================
-
-
-c-----------------------------------------------------------------------
-c   Lecture des fichiers fluxmass et  physique:
-c   -----------------------------------------------------
-
-c==================================================================
-c  Variables dynamiques
-c==================================================================
-
-         read(47,rec=irec) massemo,pbaruo,pbarvst,wo,tetao,phio
-        do l=1,llm
-           do j=1,jmo
-              do i=1,imo+1
-                 pbarvo(i,j,l)=pbarvst(i,j,l)
-              enddo
-           enddo
-        enddo
-
-         do l=1,llm
-            do jo=1,jmo+1
-               do io=1,imo+1
-                  do jn=jnord(jo)+1,jsud(jo)
-                     do in=iest(io)+1,iouest(io)
-                        wn(in,jn,l)=alpha(in,jn)*wo(io,jo,l)
-                        massemn(in,jn,l)=alpha(in,jn)
-     s                     *massemo(io,jo,l)
-                        tetan(in,jn,l)=tetao(io,jo,l)
-                        phin(in,jn,l)=phio(io,jo,l)
-                     enddo
-                  enddo
-               enddo
-            enddo
-            do jn=1,jmn+1
-               wn(imn+1,jn,l)=wn(1,jn,l)
-               massemn(imn+1,jn,l)=massemn(1,jn,l)
-               tetan(imn+1,jn,l)=tetan(1,jn,l)
-               phin(imn+1,jn,l)=phin(1,jn,l)
-            enddo
-         enddo
-
-         do l=1,llm
-            do jo=1,jmo+1
-               uu(imo+1)=0.5*(pbaruo(imo,jo,l)+pbaruo(imo+1,jo,l))
-               uu(0)=uu(imo+1)
-               do io=1,imo
-                  uu(io)=pbaruo(io,jo,l)
-               enddo
-               do io=1,imo+1
-                  do jn=jnord(jo)+1,jsud(jo)
-                     aa=0.
-                     do in=iest(io)+1,iouest(io)
-                        aa=aa+alphax(in)
-                        pbarun(in,jn,l)=alphay(jn)*
-     s                    (uu(io-1)+aa*(uu(io)-uu(io-1)))
-                     enddo
-                  enddo
-               enddo
-            enddo
-            do jn=1,jmn+1
-               pbarun(imn+1,jn,l)=pbarun(1,jn,l)
-            enddo
-         enddo
-
-         do l=1,llm
-            do jo=1,jmo
-               do io=1,imo+1
-                  vv(io,jo)=pbarvo(io,jo,l)
-               enddo
-            enddo
-            do io=1,imo+1
-               vv(io,0)=0.
-               vv(io,jmo+1)=0.
-            enddo
-            do jo=1,jmo+1
-               do io=1,imo+1
-                  aa=0.
-c                 do jn=jnord(jo)+1,max(jsud(jo),jmo)
-                  do jn=jnord(jo)+1,min(jsud(jo),jmn)
-                     aa=aa+alphay(jn)
-                     do in=iest(io)+1,iouest(io)
-                        pbarvn(in,jn,l)=alphax(in)*
-     s                  (vv(io,jo-1)+aa*(vv(io,jo)-vv(io,jo-1)))
-                     enddo
-                  enddo
-               enddo
-            enddo
-            do jn=1,jmn
-               pbarvn(iip1,jn,l)=pbarvn(1,jn,l)
-            enddo
-         enddo
-
-c==================================================================
-c  Variables physiques
-c==================================================================
-         read(49,rec=irec) ((xleco(ig,l),ig=1,ngrido),
-     s                                    l=1,9*llm+2+2*nbsrf)
-
-c==================================================================
-c  Passage  a la nouvelle grille
-c==================================================================
-         do l=1,9*llm+2+2*nbsrf
-c   passage aa la grille dynamique ancienne
-            do io=1,imo+1
-               tmpo(io,1)=xleco(1,l)
-               tmpo(io,jmo+1)=xleco(ngrido,l)
-            enddo
-            do jo=2,jmo
-               do io=1,imo
-                  tmpo(io,jo)=xleco((jo-2)*imo+io+1,l)
-               enddo
-               tmpo(imo+1,jo)=tmpo(1,jo)
-            enddo
-c   passage a la grillle dynamique nouvelle
-            do jo=1,jmo+1
-               do io=1,imo+1
-                  do jn=jnord(jo)+1,jsud(jo)
-                     do in=iest(io)+1,iouest(io)
-                        tmpn(in,jn)=tmpo(io,jo)
-                     enddo
-                  enddo
-               enddo
-            enddo
-c   passage a la grille physique nouvelle
-            xlecn(1,l)=tmpn(1,1)
-            xlecn(ngridn,l)=tmpn(1,jmn+1)
-            do jn=2,jmn
-               do in=1,imn
-                  xlecn((jn-2)*imn+in+1,l)=tmpn(in,jn)
-               enddo
-            enddo
-         enddo
-
-c==================================================================
-
-       do l=1,llm
-          do ig=1,ngridn
-             coefkz(ig,l)=xlecn(ig,icoefkz+l-1)
-             frac_impa(ig,l)=xlecn(ig,ilei+l-1)
-             frac_nucl(ig,l)=xlecn(ig,ilec+l-1)
-          enddo
-       enddo
-       do l=1,nbsrf
-          do ig=1,ngridn
-             ftsol(ig,l)=xlecn(ig,itsol+l-1)
-             pctsrf(ig,l)=xlecn(ig,ipsf+l-1)
-          enddo
-       enddo
-       do ig=1,ngridn
-          yv1(ig)=xlecn(ig,izv1)
-          yu1(ig)=xlecn(ig,izu1)
-       enddo
-C
-      if(avant) then
-c   Simu directe
-       do l=1,llm
-          do ig=1,ngridn
-             zmfu(ig,l)=xlecn(ig,imfu+l-1)
-             zmfd(ig,l)=xlecn(ig,imfd+l-1)
-             zde_u(ig,l)=xlecn(ig,ide_u+l-1)
-             zen_u(ig,l)=xlecn(ig,ien_u+l-1)
-             zde_d(ig,l)=xlecn(ig,ide_d+l-1)
-             zen_d(ig,l)=xlecn(ig,ien_d+l-1)
-          enddo
-       enddo
-      else
-c   Simu retro
-       do l=1,llm
-          do ig=1,ngridn
-             zmfd(ig,l)=-xlecn(ig,imfu+l-1)
-             zmfu(ig,l)=-xlecn(ig,imfd+l-1)
-             zen_d(ig,l)=xlecn(ig,ide_u+l-1)
-             zde_d(ig,l)=xlecn(ig,ien_u+l-1)
-             zen_u(ig,l)=xlecn(ig,ide_d+l-1)
-             zde_u(ig,l)=xlecn(ig,ien_d+l-1)
-          enddo
-       enddo
-      endif
-
-c-----------------------------------------------------------------------
-c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
-c-----------------------------------------------------------------------
-
-         call gr_dyn_fi(llm,iip1,jjp1,ngridn,massemn,massefi)
-
-      print*,'Ap redec irec'
-         do ig=1,ngridn
-            zcontrole(ig)=1.
-         enddo
-c   zmass=(max(massemn(ig,l),massemn(ig,l-1))/airefi(ig)
-         do l=2,llm
-            do ig=1,ngridn
-               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefi(ig)
-               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
-               if(zflux.gt.0.9*zmass) then
-                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
-               endif
-            enddo
-         enddo
-
-         do ig=1,ngridn
-            if(zcontrole(ig).lt.0.99999) then
-               print*,'ATTENTION !!! on reduit les flux de masse '
-               print*,'convectifs au point ig=',ig
-            endif
-         enddo
-
-         call gr_fi_dyn(1,ngridn,iip1,jjp1,zcontrole,tmpdyn)
-
-         do l=1,llm
-            do ig=1,ngridn
-               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
-               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
-               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
-               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
-               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
-               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
-            enddo
-         enddo
-
-
-      endif ! irec=0
-
-
-      RETURN
-      END
-
-
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/redecoupenc.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/redecoupenc.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/redecoupenc.F	(revision 497)
@@ -0,0 +1,1186 @@
+c
+c $Header$
+c
+      SUBROUTINE redecoupenc
+     s     (irec,massemn,pbarun,pbarvn,wn,tetan,phin,
+     s     nrec,avant,airefin,phisfin,
+     s     tn,zmfu, zmfd, zen_u, zde_u,zen_d, zde_d, coefkzn,
+     s     yu1n,yv1n,ftsoln,pctsrfn,
+     s     frac_impan,frac_nucln,phisn)
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom2.h"
+#include "tracstoke.h"
+#include "logic.h"
+
+      integer irec,nrec,i,j
+      integer ig,l
+      integer imo,jmo,imn,jmn,ii,jj,ig
+      parameter (imn=iim,jmn=jjm,imo=imn/2,jmo=(jmn+1)/2)
+      integer ngrido,ngridn
+      parameter(ngrido=(jmo-1)*imo+2,ngridn=(jmn-1)*imn+2)
+      real zdtvr
+
+      INTEGER nbsrf
+      PARAMETER (nbsrf=4) ! nombre de sous-fractions pour une maille
+
+      real zmfd(ngridn,llm),zde_d(ngridn,llm),zen_d(ngridn,llm)
+      real zmfu(ngridn,llm),zde_u(ngridn,llm),zen_u(ngridn,llm)
+	
+       logical avant
+
+      real massefi(ngridn,llm)
+
+      real massemn(imn+1,jmn+1,llm),tetan(imn+1,jmn+1,llm)
+      real pbarun(imn+1,jmn+1,llm),pbarvn(imn+1,jmn,llm)
+      real wn(imn+1,jmn+1,llm),phin(imn+1,jmn+1,llm)
+      real phisn(imn+1,jmn+1)
+
+      real massemo(imo+1,jmo+1,llm),tetao(imo+1,jmo+1,llm)
+      real pbaruo(imo+1,jmo+1,llm),pbarvo(imo+1,jmo,llm)
+      real wo(imo+1,jmo+1,llm),phio(imo+1,jmo+1,llm)
+      real phiso(imo+1,jmo+1)
+
+      real pbarvst(imo+1,jmo+1,llm)
+
+      real tmpo2(imo+1,jmo+1,llm),tmpo1(imo,jmo+1,llm)
+      real tmpo4(imo+1,jmo+1,nbsrf),tmpo3(imo,jmo+1,nbsrf)
+      real tmpo6(imo+1,jmo+1),tmpo5(imo,jmo+1)
+      real tmpn6(imn+1,jmn+1),tmpn5(imn,jmn+1)
+      real tmpn2(imn+1,jmn+1,llm),tmpn1(imn,jmn+1,llm)
+      real tmpn4(imn+1,jmn+1,nbsrf),tmpn3(imn,jmn+1,nbsrf)
+
+	real airefio(ngrido),phisfio(ngrido),
+     .    mfuo(ngrido,llm),mfdo(ngrido,llm),en_uo(ngrido,llm),
+     .    de_uo(ngrido,llm),en_do(ngrido,llm),
+     .    de_do(ngrido,llm),coefkzo(ngrido,llm),
+     .    frac_impao(ngrido,llm),frac_nuclo(ngrido,llm),
+     .    yu1o(ngrido),yv1o(ngrido),ftsolo(ngrido,nbsrf),
+     .    pctsrfo(ngrido,nbsrf),to(ngrido,llm) 
+
+      real airefin(ngridn),phisfin(ngridn),
+     .    mfun(ngridn,llm),en_un(ngridn,llm),mfdn(ngridn,llm),
+     .    de_un(ngridn,llm),en_dn(ngridn,llm),
+     .    de_dn(ngridn,llm),coefkzn(ngridn,llm),
+     .    frac_impan(ngridn,llm),frac_nucln(ngridn,llm),
+     .    ftsoln(ngridn,nbsrf),yu1n(ngridn),yv1n(ngridn),
+     .    pctsrfn(ngridn,nbsrf),tn(ngridn,llm)
+
+      real zcontrole(ngridn),zmass,tmpdyn(imn+1,jmn+1),zflux
+
+      real ziadvtrac,ziadvtrac2,zrec2
+      integer zim,zjm,zlm,zklon,zklev,zrec
+
+      real zpi
+
+c  longitudes et latitudes lues
+      real rlonul(imo+1,jmo+1),rlatvl(imo+1,jmo)
+      real rlonvl(imo+1,jmo),rlatul(imo+1,jmo+1)
+c  longitudes et latitudes anciennes
+      real rlonuo(0:imo+1),rlatvo(0:jmo+1)
+      real rlonvo(0:imo+1),rlatuo(0:jmo+1)
+c  longitudes et latitudes nouvelles
+      real rlonun(0:imn+1),rlatvn(0:jmn+1)
+      real rlonvn(0:imn+1),rlatun(0:jmn+1)
+      real aireo(imo+1,jmo+1)
+
+      integer ndecx(imo+1),ndecy(jmo+1)
+      real alphax(imn+1),alphay(jmn+1)
+      real alphaxo(imo+1)
+      real alpha(imn+1,jmn+1)
+       real alphat(imn+1,jmn+1,llm)
+      real aa,uu(0:imo+1),vv(imo+1,0:jmo+1)
+
+
+      integer iest(imo+1),iouest(imo+1)
+      integer jsud(jmo+1),jnord(jmo+1)
+
+      integer in,io,jn,jo,l,iin,jjn
+      integer i,j
+      real dlatm,dlatp,dlonm,dlonp
+c abd
+       character*10 file
+       character*10 nom
+       character*2 str2
+c fin ab
+      zpi=2.*asin(1.)
+
+
+c==================================================================
+c   Si le numero du record est 0 alors: INITIALISATION
+c==================================================================
+c
+      print*,'ENTREE DANS LECTFLUX'
+        print*,'IREC=',IREC
+      if(irec.eq.0) then
+
+        print*,'IREC==',0
+
+C test         call inigeom
+c==================================================================
+c   Definition des surdecoupages dans les deux directions
+c==================================================================
+
+      ndecx(1)=1
+      do io=2,imo
+         ndecx(io)=2
+      enddo
+      ndecx(imo+1)=1
+
+      ndecy(1)=1
+      do jo=2,jmo
+         ndecy(jo)=2
+      enddo
+      ndecy(jmo+1)=1
+
+      ii=0
+      do io=1,imo+1
+         ii=ii+ndecx(io)
+      enddo
+      if(ii.ne.iim) then
+         print*,'ii=',ii,'   iim=',iim
+         stop
+      endif
+
+      jj=0
+      do jo=1,jmo+1
+         jj=jj+ndecy(jo)
+      enddo
+      if(jj.ne.jjp1) then
+         print*,'jj=',jj,'   jjm=',jjm
+         stop
+      endif
+
+c==================================================================
+c   Calcul des jsud,... correspondant aux intersections des
+c   grilles.
+c==================================================================
+
+      iest(1)=0
+	print*,'iest(1)=0'
+      do io=2,imo+1
+         iest(io)=iest(io-1)+ndecx(io-1)
+         iouest(io-1)=iest(io)
+	print*,'iest(',io,')=',iest(io),'iouest('
+     s              ,io-1,')=',iouest(io-1)
+	
+      enddo
+      iouest(imo+1)=iest(imo+1)+ndecx(imo+1)
+	print*,'iouest(',imo+1,')=',iouest(imo+1)
+
+      jnord(1)=0
+	print*,'jnord(1)=0'
+      do jo=2,jmo+1
+         jnord(jo)=jnord(jo-1)+ndecy(jo-1)
+         jsud(jo-1)=jnord(jo)
+        print*,'jnord(',jo,')=',jnord(jo),'jsud('
+     s              ,jo-1,')=',jsud(jo-1)
+      enddo
+      jsud(jmo+1)=jnord(jmo+1)+ndecy(jmo+1)
+	        print*,'jsud(',jmo+1,')=',jsud(jmo+1)
+
+c==================================================================
+c   ouverture des fichiers, lecture des entetes
+c==================================================================
+	
+	CALL read_dstoke(0,zdtvr,ziadvtrac,ziadvtrac2)
+
+        CALL read_fstoke(0,
+     .   zrec,zim,zjm,zlm,
+     .   rlonul,rlonvl,rlatul,rlatvl,aireo,phiso,
+     .   massemo,pbaruo,pbarvo,wo,tetao,phio)
+      
+      print*,'zrec,zdtvr,ziadvtrac,zim,zjm,zlm'
+      print*,zrec,zdtvr,ziadvtrac,zim,zjm,zlm
+
+      nrec=zrec
+      dtvr=zdtvr
+      istdyn=ziadvtrac
+      istphy=ziadvtrac2
+
+      print*,'rlonul '
+      do io=1,imo+1
+         print*,io,rlonul(io,1)
+      enddo
+	print*,'rlonvl '
+      do io=1,imo+1
+         print*,io,rlonvl(io,1)
+      enddo
+	print*,'rlatul '
+      do jo=1,jmo+1
+         print*,jo,rlatul(1,jo)
+      enddo
+	print*,'rlatvl'
+      do jo=1,jmo
+         print*,jo,rlatvl(1,jo)
+      enddo
+      
+c      if((imo-nint(zim))*(jmo-nint(zjm)).ne.0) then
+c        print*,'Modifier les dimensions dans redecoupe '
+c        print*,'Mettre imo=',zim,'   jmo=',zjm
+c  abderr      stop
+c      endif
+
+c abderrahmane
+	if(physic)then
+	CALL read_pstoke(0,
+     .   zrec,zklon,zklev,airefio,phisfio,
+     .   to,mfuo,mfdo,en_uo,de_uo,en_do,de_do,coefkzo,
+     .   frac_impao,frac_nuclo,yu1o,yv1o,ftsolo,pctsrfo)
+	
+	print*,'Entete du fichier physique'
+        print*,zrec,zklon,zklev
+	endif
+
+
+c==================================================================
+c   Definition des anciennes latitudes et longitudes
+c   (qui pourraient etre relues plus tard)
+c==================================================================
+
+
+      do io=1,imo
+         rlonuo(io)=rlonul(io,1)*zpi/180.
+	print*,'LON ',io,rlonuo(io)*180./zpi
+      enddo
+c abderr
+      rlonuo(imo+1)=0.5*(rlonul(imo,1)+rlonul(imo+1,1))*zpi/180.
+      print*,'LON ',imo+1,rlonuo(imo+1)*180./zpi
+      rlonuo(0)=rlonuo(imo+1)-2.*zpi
+      print*,'LON ',0,rlonuo(0)*180./zpi
+
+c abder
+c ATTENTION A REVOIR
+c	goto 22
+      do io=1,imo
+         rlonvo(io)=rlonvl(io,1)*zpi/180.
+        print*,'LON ',io,rlonvo(io)*180./zpi
+      enddo
+      rlonvo(imo+1)=0.5*(rlonvl(imo,1)+rlonvl(imo+1,1))*zpi/180.
+      print*,'LON ',imo+1,rlonvo(imo+1)*180./zpi
+      rlonvo(0)=rlonvo(imo+1)-2.*zpi
+      print*,'LON ',0,rlonvo(0)*180./zpi
+22    continue
+c fin ab
+
+      rlatvo(0)=zpi/2.
+      print*,'LAT ',0,rlatvo(0)*180./zpi
+      do jo=1,jmo
+        rlatvo(jo)=rlatvl(1,jo)*zpi/180.
+	print*,'LAT ',jo,rlatvo(jo)*180./zpi
+      enddo
+	rlatvo(jmo+1)=-zpi/2.
+	print*,'LAT ',jmo+1,rlatvo(jmo+1)*180./zpi
+c abd
+c ATTENTION A REVOIR
+c	goto 33
+c      rlatuo(0)=zpi/2.
+c      print*,'LAT ',0,rlatuo(0)*180./zpi
+      do jo=1,jmo+1
+        rlatuo(jo-1)=rlatul(1,jo)*zpi/180.
+        print*,'LAT ',jo-1,rlatuo(jo-1)*180./zpi
+      enddo
+        rlatuo(jmo+1)=-zpi/2.
+        print*,'LAT ',jmo+1,rlatuo(jmo+1)*180./zpi
+33    continue
+c abd
+
+      do io=2,imo
+         alphaxo(io)=1.
+      enddo
+      alphaxo(1)=(rlonuo(1)-rlonuo(0))
+     s        /(rlonuo(1)-rlonuo(0)+rlonuo(imo+1)-rlonuo(imo))
+      alphaxo(imo+1)=1.-alphaxo(1)
+
+c==================================================================
+c    Definition des nouvelles latitudes et longitudes
+c==================================================================
+
+c Nouvelles longitudes rlonun
+      rlonun(0)=rlonuo(0)
+      do io=1,imo+1
+         do iin=1,iouest(io)-iest(io)
+            in=iin+iest(io)
+            rlonun(in)=
+     s      rlonuo(io-1)+iin*(rlonuo(io)-rlonuo(io-1))
+     s      /ndecx(io)
+            alphax(in)=alphaxo(io)/ndecx(io)
+            print787,io,rlonuo(io-1)*180./zpi,in
+     s  ,iest(io),iouest(io),rlonun(in)*180./zpi,alphax(in)
+         enddo
+      enddo
+
+c Nouvelles longitudes rlonvn
+c	goto 44
+      rlonvn(0)=rlonvo(0)
+      do io=1,imo+1
+         do iin=1,iouest(io)-iest(io)
+            in=iin+iest(io)
+            rlonvn(in)=
+     s      rlonvo(io-1)+iin*(rlonvo(io)-rlonvo(io-1))
+     s      /ndecx(io)
+            alphax(in)=alphaxo(io)/ndecx(io)
+            print787,io,rlonvo(io-1)*180./zpi,in
+     s  ,iest(io),iouest(io),rlonvn(in)*180./zpi,alphax(in)
+         enddo
+      enddo
+44    continue
+
+c Nouvelles latitudes rlatvn
+      rlatvn(0)=0.5*zpi
+      do jo=1,jmo+1
+         do jjn=1,jsud(jo)-jnord(jo)
+            jn=jnord(jo)+jjn
+            rlatvn(jn)=
+     s      rlatvo(jo-1)+jjn*(rlatvo(jo)-rlatvo(jo-1))
+     s      /ndecy(jo)
+            alphay(jn)=(sin(rlatvn(jn-1))-sin(rlatvn(jn)))
+     s                /(sin(rlatvo(jo-1))-sin(rlatvo(jo)))
+           print*,jn,rlatvn(jn)*180./zpi
+         enddo
+      enddo
+
+c Nouvelles latitudes rlatun
+c	goto 55
+      rlatun(0)=0.5*zpi
+      do jo=1,jmo+1
+         do jjn=1,jsud(jo)-jnord(jo)
+            jn=jnord(jo)+jjn
+            rlatun(jn)=
+     s      rlatuo(jo-1)+jjn*(rlatuo(jo)-rlatuo(jo-1))
+     s      /ndecy(jo)
+           print*,jn,rlatvn(jn)*180./zpi
+         enddo
+      enddo
+55    continue
+
+787   format(i5,f10.2,3(i5),2(f12.6))
+      do in=1,imn
+         rlonu(in)=rlonun(in)
+         rlonv(in)=0.5*(rlonun(in)+rlonun(in-1))
+      enddo
+      rlonv(imn+1)=rlonv(1)+2.*zpi
+      rlonu(imn+1)=rlonu(1)+2.*zpi
+
+      do jn=1,jmn
+         rlatv(jn)=rlatvn(jn)
+      enddo
+      do jn=1,jmn+1
+         rlatu(jn)=0.5*(rlatvn(jn-1)+rlatvn(jn))
+      enddo
+
+      do jn=1,jmn+1
+         do in=1,imn
+            alpha(in,jn)=alphax(in)*alphay(jn)
+	    alphat(in,jn,1)=alpha(in,jn)
+         enddo
+         alpha(imn+1,jn)=0.
+	 alphat(imn+1,jn,1)=0.
+      enddo
+c abderr 19 4 00
+	do l=2,llm
+	 do jn=1,jmn+1
+         do in=1,imn+1
+	  alphat(in,jn,l)=alphat(in,jn,1)
+         enddo
+	 enddo
+        enddo
+c     call dump2d(iip1,jjp1,alpha,'ALPHA   ')
+
+c      .  on a :  cu(i,j) = rad * COS(y) * dx/dX         .
+c      .          cv( j ) = rad          * dy/dY         .
+c   A 1 point scalaire P (i,j) de la grille, reguliere en (X,Y) , sont
+c   affectees 4 aires entourant P , calculees respectivement aux points
+c            ( i + 1/4, j - 1/4 )    :    aireij1 (i,j)
+c            ( i + 1/4, j + 1/4 )    :    aireij2 (i,j)
+c            ( i - 1/4, j + 1/4 )    :    aireij3 (i,j)
+c            ( i - 1/4, j - 1/4 )    :    aireij4 (i,j)
+c
+c                             . V
+c
+c                 aireij4 .        . aireij1
+c
+c                   U .       . P      . U
+c
+c                 aireij3 .        . aireij2
+c
+c                             . V
+
+
+      do j=1,jjp1
+         do i=1,iim
+            dlonp=rlonun(i)-rlonv(i)
+            dlonm=rlonv(i)-rlonun(i-1)
+            dlatp=sin(rlatvn(j-1))-sin(rlatu(j))
+            dlatm=sin(rlatu(j))-sin(rlatvn(j))
+            aireij1 ( i,j ) = rad*rad*dlatp*dlonp
+            aireij2 ( i,j ) = rad*rad*dlatm*dlonp
+            aireij3 ( i,j ) = rad*rad*dlatm*dlonm
+            aireij4 ( i,j ) = rad*rad*dlatp*dlonm
+      aire    ( i,j )  = aireij1(i,j) + aireij2(i,j) + aireij3(i,j) +
+     *                          aireij4(i,j)
+      alpha1  ( i,j )  = aireij1(i,j) / aire(i,j)
+      alpha2  ( i,j )  = aireij2(i,j) / aire(i,j)
+      alpha3  ( i,j )  = aireij3(i,j) / aire(i,j)
+      alpha4  ( i,j )  = aireij4(i,j) / aire(i,j)
+      alpha1p2( i,j )  = alpha1 (i,j) + alpha2 (i,j)
+      alpha1p4( i,j )  = alpha1 (i,j) + alpha4 (i,j)
+      alpha2p3( i,j )  = alpha2 (i,j) + alpha3 (i,j)
+      alpha3p4( i,j )  = alpha3 (i,j) + alpha4 (i,j)
+           enddo
+           aireij1(iip1,j)=aireij1(1,j)
+           aireij2(iip1,j)=aireij2(1,j)
+           aireij3(iip1,j)=aireij3(1,j)
+           aireij4(iip1,j)=aireij4(1,j)
+           aire(iip1,j)=aire(1,j)
+           alpha1(iip1,j)=alpha1(1,j)
+           alpha2(iip1,j)=alpha2(1,j)
+           alpha3(iip1,j)=alpha3(1,j)
+           alpha4(iip1,j)=alpha4(1,j)
+           alpha1p2(iip1,j)=alpha1p2(1,j)
+           alpha1p4(iip1,j)=alpha1p4(1,j)
+           alpha2p3(iip1,j)=alpha2p3(1,j)
+           alpha3p4(iip1,j)=alpha3p4(1,j)
+       enddo
+c     call dump2d(iip1,jjp1,aire,'AIRE   ')
+
+      DO 42 j = 1,jjp1
+      DO 41 i = 1,iim
+      unsaire(i,j) = 1./ aire(i,j)
+      aireu  (i,j) = aireij1(i,j) + aireij2(i,j) + aireij4(i+1,j) +
+     *                           aireij3(i+1,j)
+  41  CONTINUE
+      aireu  (iip1,j) = aireu  (1,j)
+      unsaire(iip1,j) = unsaire(1,j)
+  42  CONTINUE
+      DO 48 j = 1,jjm
+        DO i=1,iim
+         airev(i,j)     = aireij2(i,j)+ aireij3(i,j)+ aireij1(i,j+1) +
+     *                           aireij4(i,j+1)
+        ENDDO
+       airev   (iip1,j) = airev(1,j)
+  48  CONTINUE
+      apoln=0.
+      apols=0.
+      do i=1,iim
+         apoln=apoln+aire(i,1)
+         apols=apols+aire(i,jjp1)
+      enddo
+
+
+
+      do jn=1,jjp1
+         do in=1,iim
+            cu(in,jn)=rad*cos(rlatu(jn))*(rlonv(in+1)-rlonv(in))
+         enddo
+         cu(iip1,jn)=cu(1,jn)
+      enddo
+      do jn=1,jjm
+         do in=1,iim+1
+            cv(in,jn)=rad*(rlatu(jn)-rlatu(jn+1))
+         enddo
+      enddo
+	Print*,'Fin irec=0'
+	go to 435
+      file='pbur'
+      call inigrads(11,iip1
+     s  ,rlonu,180./pi,-180.,180.,jjp1,rlatu,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,1800.,file,'gcmq2 ')
+      file='pbvr'
+      call inigrads(12,iip1
+     s  ,rlonv,180./pi,-180.,180.,jjm,rlatv,-90.,90.,180./pi
+     s  ,llm,presnivs,1.
+     s  ,1800.,file,'gcmq2 ')
+435   continue
+c==================================================================
+c   Fin des initialisations
+      else ! irec=0
+c==================================================================
+
+
+c-----------------------------------------------------------------------
+c   Lecture des fichiers fluxmass et  physique:
+c   -----------------------------------------------------
+	print*,'Entrer dans read_fstoke a irec=',irec
+	CALL read_fstoke(irec,
+     .   zrec,zim,zjm,zlm,
+     .   rlonul,rlonvl,rlatul,rlatvl,aireo,phiso,
+     .   massemo,pbaruo,pbarvo,wo,tetao,phio)
+
+	print*,'Apres read_fstoke a irec=',irec
+
+c	do l=1,llm
+c           do j=1,jmo
+c              do i=1,imo+1
+c                 pbarvo(i,j,l)=pbarvst(i,j,l)
+c              enddo
+c           enddo
+c        enddo
+
+         do l=1,llm
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+c                        wn(in,jn,l)=alpha(in,jn)*wo(io,jo,l)
+c                        massemn(in,jn,l)=alpha(in,jn)
+		       wn(in,jn,l)=alphat(in,jn,l)*wo(io,jo,l)
+		       massemn(in,jn,l)=alphat(in,jn,l)
+     s                                *massemo(io,jo,l)
+                        tetan(in,jn,l)=tetao(io,jo,l)
+                        phin(in,jn,l)=phio(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               wn(imn+1,jn,l)=wn(1,jn,l)
+               massemn(imn+1,jn,l)=massemn(1,jn,l)
+               tetan(imn+1,jn,l)=tetan(1,jn,l)
+               phin(imn+1,jn,l)=phin(1,jn,l)
+            enddo
+         enddo
+c Test massemn
+	print*,'MASSE DANS LA NOUVELLE GRILLE'
+	goto 908
+	do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+	print*,'massemn(',in,jn,1,')=',massemn(in,jn,1)
+        	     enddo
+                  enddo
+               enddo
+	enddo
+	do jn=1,jmn+1
+	print*,'massemn(',imn+1,jn,1,')=',massemn(imn+1,jn,1)
+        enddo
+908     continue
+	print*,'Fin calcul de massemn pour nouv. gril.'
+         do l=1,llm
+            do jo=1,jmo+1
+               uu(imo+1)=0.5*(pbaruo(imo,jo,l)+pbaruo(imo+1,jo,l))
+               uu(0)=uu(imo+1)
+               do io=1,imo
+                  uu(io)=pbaruo(io,jo,l)
+               enddo
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     aa=0.
+                     do in=iest(io)+1,iouest(io)
+                        aa=aa+alphax(in)
+                        pbarun(in,jn,l)=alphay(jn)*
+     s                    (uu(io-1)+aa*(uu(io)-uu(io-1)))
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               pbarun(imn+1,jn,l)=pbarun(1,jn,l)
+            enddo
+         enddo
+	print*,'Fin calcul de pbarun'
+	
+	do l=1,llm
+            do jo=1,jmo
+               do io=1,imo+1
+                  vv(io,jo)=pbarvo(io,jo,l)
+               enddo
+            enddo
+            do io=1,imo+1
+               vv(io,0)=0.
+               vv(io,jmo+1)=0.
+            enddo
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  aa=0.
+c                 do jn=jnord(jo)+1,max(jsud(jo),jmo)
+                  do jn=jnord(jo)+1,min(jsud(jo),jmn)
+                     aa=aa+alphay(jn)
+                     do in=iest(io)+1,iouest(io)
+                        pbarvn(in,jn,l)=alphax(in)*
+     s                  (vv(io,jo-1)+aa*(vv(io,jo)-vv(io,jo-1)))
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn
+               pbarvn(iip1,jn,l)=pbarvn(1,jn,l)
+            enddo
+         enddo
+
+c abd
+	go to 456
+ 	nom='pbaru'
+        call wrgrads(11,llm,pbarun(:,:,1),nom,nom)
+        nom='pbarv'
+        call wrgrads(12,llm,pbarvn(:,:,1),nom,nom)
+        nom='masse'
+        call wrgrads(11,llm,massemn(:,:,1),nom,nom)
+        nom='w'
+        call wrgrads(11,llm,wn(:,:,1),nom,nom)
+456	continue
+c fin ab
+
+	if(physic)then
+        CALL read_pstoke(irec,
+     .   zrec,zklon,zklev,airefio,phisfio,
+     .   to,mfuo,mfdo,en_uo,de_uo,en_do,de_do,coefkzo,
+     .   frac_impao,frac_nuclo,yu1o,yv1o,ftsolo,pctsrfo)
+       	print*,'OK read_pstoke pour irec=',irec
+c==================================================================
+c  Passage  a la nouvelle grille
+c==================================================================
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,to,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=to(1,l)
+                tmpo2(imo+1,jmo+1,l)=to(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,tn)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+
+	call gr_fi_ecrit(llm,ngrido,imo,jmo+1,mfuo,tmpo1)
+	do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+		tmpo2(imo+1,1,l)=mfuo(1,l)
+                tmpo2(imo+1,jmo+1,l)=mfuo(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+		tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+	enddo
+	call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,mfun)
+	call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+	call initial0(llm*imo*(jmo+1),tmpo1)
+	call initial0(llm*imn*(jmn+1),tmpn1)
+	call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,mfdo,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=mfdo(1,l)
+                tmpo2(imo+1,jmo+1,l)=mfdo(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,mfdn)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,en_uo,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=en_uo(1,l)
+                tmpo2(imo+1,jmo+1,l)=en_uo(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,en_un)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,en_do,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=en_do(1,l)
+                tmpo2(imo+1,jmo+1,l)=en_do(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,en_dn)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,de_do,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=de_do(1,l)
+                tmpo2(imo+1,jmo+1,l)=de_do(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,de_dn)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,de_uo,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=de_uo(1,l)
+                tmpo2(imo+1,jmo+1,l)=de_uo(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,de_un)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,coefkzo,tmpo1)
+	do l=1,llm
+	   do jo=1,jmo+1
+	      do io=1,imo
+		tmpo2(io,jo,l)=tmpo1(io,jo,l)
+	      enddo
+	   enddo
+
+           tmpo2(imo+1,1,l)=coefkzo(1,l)
+           tmpo2(imo+1,jmo+1,l)=coefkzo(ngrido,l)
+
+           do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo2(1,jo,l)
+           enddo
+	enddo
+	      
+c   passage a la grillle dynamique nouvelle
+	do l=1,llm	
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,coefkzn)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,frac_impao,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=frac_impao(1,l)
+                tmpo2(imo+1,jmo+1,l)=frac_impao(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,frac_impan)
+        call initial0(llm*(imo+1)*(jmo+1),tmpo2)
+        call initial0(llm*imo*(jmo+1),tmpo1)
+        call initial0(llm*imn*(jmn+1),tmpn1)
+        call initial0(llm*(imn+1)*(jmn+1),tmpn2)
+        call gr_fi_ecrit(llm,ngrido,imo,jmo+1,frac_nuclo,tmpo1)
+        do l=1,llm
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo2(io,jo,l)=tmpo1(io,jo,l)
+              enddo
+           enddo
+
+                tmpo2(imo+1,1,l)=frac_nuclo(1,l)
+                tmpo2(imo+1,jmo+1,l)=frac_nuclo(ngrido,l)
+            do jo=2,jmo
+                tmpo2(imo+1,jo,l)=tmpo1(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn2(in,jn,l)=tmpo2(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn1(in,jn,l)=tmpn2(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(llm,ngridn,imn,jmn+1,tmpn1,frac_nucln)
+
+        call gr_fi_ecrit(nbsrf,ngrido,imo,jmo+1,ftsolo,tmpo3)
+        do l=1,nbsrf
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo4(io,jo,l)=tmpo3(io,jo,l)
+              enddo
+           enddo
+
+                tmpo4(imo+1,1,l)=ftsolo(1,l)
+                tmpo4(imo+1,jmo+1,l)=ftsolo(ngrido,l)
+            do jo=2,jmo
+                tmpo4(imo+1,jo,l)=tmpo3(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn4(in,jn,l)=tmpo3(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn3(in,jn,l)=tmpn4(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(nbsrf,ngridn,imn,jmn+1,tmpn3,ftsoln)
+
+        call initial0(nbsrf*(imo+1)*(jmo+1),tmpo4)
+        call initial0(nbsrf*imo*(jmo+1),tmpo3)
+        call initial0(nbsrf*imn*(jmn+1),tmpn3)
+        call initial0(nbsrf*(imn+1)*(jmn+1),tmpn4)
+        call gr_fi_ecrit(nbsrf,ngrido,imo,jmo+1,pctsrfo,tmpo3)
+        do l=1,nbsrf
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo4(io,jo,l)=tmpo3(io,jo,l)
+              enddo
+           enddo
+
+                tmpo4(imo+1,1,l)=pctsrfo(1,l)
+                tmpo4(imo+1,jmo+1,l)=pctsrfo(ngrido,l)
+            do jo=2,jmo
+                tmpo4(imo+1,jo,l)=tmpo3(1,jo,l)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn4(in,jn,l)=tmpo3(io,jo,l)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn3(in,jn,l)=tmpn4(in,jn,l)
+               enddo
+            enddo
+        enddo
+        call gr_ecrit_fi(nbsrf,ngridn,imn,jmn+1,tmpn3,pctsrfn)
+
+        call gr_fi_ecrit(1,ngrido,imo,jmo+1,yv1o,tmpo5)
+
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo6(io,jo)=tmpo5(io,jo)
+              enddo
+           enddo
+
+                tmpo6(imo+1,1)=yv1o(1)
+                tmpo6(imo+1,jmo+1)=yv1o(ngrido)
+            do jo=2,jmo
+                tmpo6(imo+1,jo)=tmpo5(1,jo)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn6(in,jn)=tmpo5(io,jo)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn5(in,jn)=tmpn6(in,jn)
+               enddo
+            enddo
+        call gr_ecrit_fi(1,ngridn,imn,jmn+1,tmpn5,yv1n)
+
+        call initial0((imo+1)*(jmo+1),tmpo6)
+        call initial0(imo*(jmo+1),tmpo5)
+        call initial0(imn*(jmn+1),tmpn5)
+        call initial0((imn+1)*(jmn+1),tmpn6)
+        call gr_fi_ecrit(1,ngrido,imo,jmo+1,yu1o,tmpo5)
+
+           do jo=1,jmo+1
+              do io=1,imo
+                tmpo6(io,jo)=tmpo5(io,jo)
+              enddo
+           enddo
+
+                tmpo6(imo+1,1)=yu1o(1)
+                tmpo6(imo+1,jmo+1)=yu1o(ngrido)
+            do jo=2,jmo
+                tmpo6(imo+1,jo)=tmpo5(1,jo)
+            enddo
+c   passage a la grillle dynamique nouvelle
+            do jo=1,jmo+1
+               do io=1,imo+1
+                  do jn=jnord(jo)+1,jsud(jo)
+                     do in=iest(io)+1,iouest(io)
+                        tmpn6(in,jn)=tmpo5(io,jo)
+                     enddo
+                  enddo
+               enddo
+            enddo
+            do jn=1,jmn+1
+               do in=1,imn
+                tmpn5(in,jn)=tmpn6(in,jn)
+               enddo
+            enddo
+        call gr_ecrit_fi(1,ngridn,imn,jmn+1,tmpn5,yu1n)
+c==================================================================
+	if (avant) then
+c Simu directe
+         do l=1,llm
+          do ig=1,ngridn
+	     zmfd(ig,l)=mfdn(ig,l)
+             zmfu(ig,l)=mfun(ig,l)
+             zen_d(ig,l)=en_dn(ig,l)
+             zde_d(ig,l)=de_dn(ig,l)
+             zen_u(ig,l)=en_un(ig,l)
+             zde_u(ig,l)=de_un(ig,l)
+          enddo
+       enddo
+      else
+c   Simu retro
+       do l=1,llm
+          do ig=1,ngridn
+             zmfd(ig,l)=-mfdn(ig,l)
+             zmfu(ig,l)=-mfun(ig,l)
+             zen_d(ig,l)=en_dn(ig,l)
+             zde_d(ig,l)=de_dn(ig,l)
+             zen_u(ig,l)=en_un(ig,l)
+             zde_u(ig,l)=de_un(ig,l)
+          enddo
+       enddo
+      endif
+
+c-----------------------------------------------------------------------
+c   PETIT CONTROLE SUR LES FLUX CONVECTIFS...
+c-----------------------------------------------------------------------
+
+         call gr_dyn_fi(llm,iip1,jjp1,ngridn,massemn,massefi)
+
+      print*,'Ap redec irec'
+         do ig=1,ngridn
+            zcontrole(ig)=1.
+         enddo
+c   zmass=(max(massemn(ig,l),massemn(ig,l-1))/airefin(ig)
+         do l=2,llm
+            do ig=1,ngridn
+               zmass=max(massefi(ig,l),massefi(ig,l-1))/airefin(ig)
+               zflux=max(abs(zmfu(ig,l)),abs(zmfd(ig,l)))*dtphys
+               if(zflux.gt.0.9*zmass) then
+                 zcontrole(ig)=min(zcontrole(ig),0.9*zmass/zflux)
+               endif
+            enddo
+         enddo
+
+         do ig=1,ngridn
+            if(zcontrole(ig).lt.0.99999) then
+               print*,'ATTENTION !!! on reduit les flux de masse '
+               print*,'convectifs au point ig=',ig
+            endif
+         enddo
+
+         call gr_fi_dyn(1,ngridn,iip1,jjp1,zcontrole,tmpdyn)
+
+         do l=1,llm
+            do ig=1,ngridn
+               zmfu(ig,l)=zmfu(ig,l)*zcontrole(ig)
+               zmfd(ig,l)=zmfd(ig,l)*zcontrole(ig)
+               zen_u(ig,l)=zen_u(ig,l)*zcontrole(ig)
+               zde_u(ig,l)=zde_u(ig,l)*zcontrole(ig)
+               zen_d(ig,l)=zen_d(ig,l)*zcontrole(ig)
+               zde_d(ig,l)=zde_d(ig,l)*zcontrole(ig)
+            enddo
+         enddo
+	endif ! physic
+
+      endif ! irec=0
+
+
+      RETURN
+      END
+
+
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/run.def
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/run.def	(revision 3)
+++ 	(revision )
@@ -1,187 +1,0 @@
-
------------------------------------------------------------------------ 
-Parametres de controle du run:                                          
-------------------------------                                          
-
-- Jour de l'etat initial ( = 350  si 20 Decembre ,par expl. ,comme ici ) 
-   dayref
- 350
-
--  Annee de l'etat  initial (   avec  4  chiffres   )                        
-   anneeref
- 1987
-
-- Nombre de jours d'integration                                         
-     nday
- 2
-
-- nombre de pas par jour (multiple de iperiod) ( ici pour  dt = 1 min )      
- day_step
- 1440
-
-- periode pour le pas Matsuno (en pas)                                  
-  iperiod
- 5
-
-- periode de sortie des variables de controle (en pas)                  
-  iconser
- 5
-
-- periode d'ecriture du fichier histoire (en jour)                      
-    iecri
- 100
-
-- periode de stockage fichier histmoy (en jour)                         
- periodav
- 60.
-
-- periode de la dissipation (en pas)                                    
-  idissip
- 10
-
-- choix de l'operateur de dissipation (star ou  non star )              
- lstardis
- T
-
-- nombre d'iterations de l'operateur de dissipation   gradiv            
-nitergdiv
- 1
-
-- nombre d'iterations de l'operateur de dissipation  nxgradrot          
-nitergrot
- 2
-
-- nombre d'iterations de l'operateur de dissipation  divgrad            
-   niterh
- 2
-
-- temps de dissipation des plus petites long.d ondes pour u,v (gradiv)  
- tetagdiv
- 3000.
-
-- temps de dissipation des plus petites long.d ondes pour u,v(nxgradrot)
- tetagrot
- 3000.
-
-- temps de dissipation des plus petites long.d ondes pour  h ( divgrad) 
- tetatemp
- 3000.
-
-- coefficient pour gamdissip                                            
-  coefdis
- 0.
-
-- choix du shema d'integration temporelle (Matsuno ou Matsuno-leapfrog) 
-  purmats
- F
-
-- avec ou sans physique                                                 
-   physic
- T
-
-- periode de la physique (en pas)                                       
-  iphysiq
- 15
-
-- frequence (en  jours ) de l'ecriture du fichier histphy               
- ecritphy
- 4
-
--  Cycle diurne  ou non                 
- cycle_diurne
- T
-
--  Soil Model  ou non               
- soil_model
- F
-
--  Choix ou non  de  New oliq               
- new_oliq
- T
-
--  Orodr  ou  non   pour l orographie              
-  ok_orodr
- T
-
--  Orolf  ou  non   pour l orographie              
-  ok_orolf
- T
-
--   Si = .T. ,  lecture du fichier limit avec la bonne annee             
-  ok_limitvrai
- T
-
-- Nombre  d'appels des routines de rayonnements ( par jour)                 
-  nbapp_rad
- 12
-
--  Flag  pour la convection ( 1 pour LMD,  2 pour Tiedtke, 3  CCM )             
-  iflag_con
- 2
-
-- longitude en degres du centre du zoom                                 
-   clon
- 63.
-
-- latitude en degres du centre du zoom                                  
-   clat
- 0.
-
-- facteur de grossissement du zoom,selon longitude                      
-  grossismx
- 2.5
-
-- facteur de grossissement du zoom ,selon latitude                      
- grossismy
- 2.5
-
--  Fonction  f(y)  hyperbolique  si = .true.  , sinon  sinusoidale         
-  fxyhypb
- T
-
-- extension en longitude  de la zone du zoom  ( fraction de la zone totale)
-   dzoomx
- 0.291667
-
-- extension en latitude de la zone  du zoom  ( fraction de la zone totale)
-   dzoomy
- 0.291667
-
--  Fonction  f(y) avec y = Sin(latit.) si = .true. , sinon y = latit.         
-  ysinus
- T
-
-c
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-cc
-c   Autres  parametres ou cles  , non places dans run.def  mais
-c             dans les routines .
-cc
-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-cc
-cc  A )   iadv(iq )  , iq =1, nqmx , avec  iadv = 1  , shema humid.
-cc                                                  specifique LMD
-cc
-cc                                avec  iadv = 2  , shema amont
-cc
-cc                (  avec a l'interieur de amont , la cle amont_qs ) 
-cc
-cc                                avec  iadv = 3 , shema Van_Leer
-cc
-cc                                           dans  ***  gcm.F  ****
-cc 
-cc  B )  ok_oasis   , pour coupleur Oasis  , dans  *** physiq.F ***
-cc
-cc  C )  ok_ocean                            dans  *** physiq.F ***
-cc
-cc  D )  ok_journe , ok_instan, ok_region   pour sorties analyses
-c
-cc                                           dans  *** physiq.F ***
-cc
-cc  E ) nvm  : nbre  de vegetations    
-cc                                           dans  *** physiq.F ***
-
-cc  F ) deltay : deplacement ( en degres ) en  y  de la zone du zoom
-cc                                          dans  *** inigeom.F ***
-
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/serre.h
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/serre.h	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/serre.h	(revision 497)
@@ -1,6 +1,9 @@
+c
+c $Header$
+c
 c..include serre.h
 c
        REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
-     ,  grossismx, grossismy, dzoomx, dzoomy
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
        COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo , 
-     ,  grossismx, grossismy, dzoomx, dzoomy
+     ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/sort.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/sort.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/sort.F	(revision 497)
@@ -0,0 +1,35 @@
+C
+C $Header$
+C
+      SUBROUTINE sort(n,d)
+c
+c     P.Le Van
+c      
+c...  cette routine met le tableau d  dans l'ordre croissant  ....
+cc   ( pour avoir l'ordre decroissant,il suffit de remplacer l'instruc
+c      tion  situee + bas  IF(d(j).LE.p)  THEN     par
+c                           IF(d(j).GE.p)  THEN
+c
+
+      INTEGER n
+      REAL d(n) , p
+      INTEGER i,j,k
+
+      DO i=1,n-1
+        k=i
+        p=d(i)
+        DO j=i+1,n
+         IF(d(j).LE.p) THEN
+           k=j
+           p=d(j)
+         ENDIF
+        ENDDO
+
+       IF(k.ne.i) THEN
+         d(k)=d(i)
+         d(i)=p
+       ENDIF
+      ENDDO
+
+       RETURN
+       END
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/sortvarc0.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/sortvarc0.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/sortvarc0.F	(revision 497)
@@ -1,4 +1,5 @@
       SUBROUTINE sortvarc0
-     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time )
+     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
+     $ vcov)
       IMPLICIT NONE
 
@@ -32,4 +33,5 @@
       INTEGER itau
       REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
+      REAL vcov(ip1jm,llm)
       REAL ps(ip1jmp1),phis(ip1jmp1)
       REAL vorpot(ip1jm,llm)
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/startvar.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/startvar.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/startvar.F	(revision 497)
@@ -1,2 +1,5 @@
+C
+C $Header$
+C
       MODULE startvar
     !
@@ -10,13 +13,12 @@
     !
     !        - A 2D variable on the dynamical grid :
-    !           CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex)
-    !            
+    !           CALL startget(varname, iml, jml, lon_in, lat_in, champ, val_ex, jml2, lon_in2, lat_in2, interbar )             
     !
     !        - A 1D variable on the physical grid :
-    !            CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp)
+    !            CALL startget(varname, iml, jml, lon_in, lat_in, nbindex, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
     !
     !
     !         - A 3D variable on the dynamical grid :
-    !            CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp)
+    !            CALL startget(varname, iml, jml, lon_in, lat_in, lml, pls, workvar, champ, val_exp, jml2, lon_in2, lat_in2, interbar )
     !
     !
@@ -57,5 +59,5 @@
       REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lat_phys, lat_rug,
      . lat_alb, lat_rel, lat_dyn
-      REAL, ALLOCATABLE, SAVE, DIMENSION (:)  :: lev_dyn
+      REAL, ALLOCATABLE, SAVE, DIMENSION (:)  :: levdyn_ini
       REAL, ALLOCATABLE, SAVE, DIMENSION (:,:)  :: relief, zstd, zsig,
      . zgam, zthe, zpic, zval
@@ -70,5 +72,5 @@
     !
       SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in,
-     . champ, val_exp)
+     . champ, val_exp, jml2, lon_in2, lat_in2 , interbar, masque_lu )
     !
     !    There is a big mess with the size in logitude, should it be iml or iml+1.
@@ -79,8 +81,11 @@
     !
       CHARACTER*(*), INTENT(in) :: varname
-      INTEGER, INTENT(in) :: iml, jml
+      INTEGER, INTENT(in) :: iml, jml ,jml2
       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
+      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
       REAL, INTENT(inout) :: champ(iml,jml)
       REAL, INTENT(in) :: val_exp
+      REAL, INTENT(in), optional :: masque_lu(iml,jml) 
+      LOGICAL interbar
     !
     !   This routine only works if the variable does not exist or is constant
@@ -97,5 +102,11 @@
                   IF ( .NOT.ALLOCATED(relief)) THEN
                       !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in)
+                    if (present(masque_lu)) then
+                      CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .                    jml2,lon_in2,lat_in2, interbar, masque_lu )
+                    else
+                      CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .                    jml2,lon_in2,lat_in2, interbar)
+                    endif
                       !
                   ENDIF
@@ -117,5 +128,6 @@
                   IF ( .NOT.ALLOCATED(rugo)) THEN
                       !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in)
+                      CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .                    jml2,lon_in2,lat_in2 , interbar )
                       !
                   ENDIF
@@ -137,5 +149,6 @@
                   IF ( .NOT.ALLOCATED(masque)) THEN
                       !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in)
+                      CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .                     jml2,lon_in2,lat_in2 , interbar )
                       !
                   ENDIF
@@ -157,5 +170,6 @@
                   IF ( .NOT.ALLOCATED(phis)) THEN
                       !
-                      CALL start_init_orog( iml, jml, lon_in, lat_in)
+                      CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .                   jml2,lon_in2, lat_in2 , interbar )
                       !
                   ENDIF
@@ -177,5 +191,6 @@
                   IF ( .NOT.ALLOCATED(psol_dyn)) THEN
                       !
-                      CALL start_init_dyn( iml, jml, lon_in, lat_in)
+                      CALL start_init_dyn( iml, jml, lon_in, lat_in,
+     .                   jml2,lon_in2, lat_in2 , interbar )
                       !
                   ENDIF
@@ -231,18 +246,25 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !
-      SUBROUTINE start_init_orog( iml, jml, lon_in, lat_in)
-    !
-      INTEGER, INTENT(in) :: iml, jml
+      SUBROUTINE start_init_orog ( iml,jml,lon_in, lat_in,jml2,lon_in2 ,
+     ,   lat_in2 , interbar, masque_lu )
+    !
+      INTEGER, INTENT(in) :: iml, jml, jml2
       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
+      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
+      REAL, intent(in), optional :: masque_lu(iml,jml)
+      LOGICAL interbar
     !
     !  LOCAL
     !
-      REAL :: lev(1), date, dt
+      LOGICAL interbar2
+      REAL :: lev(1), date, dt,chmin,chmax
       INTEGER :: itau(1), fid
       INTEGER ::  llm_tmp, ttm_tmp
       INTEGER :: i, j
       INTEGER :: iret
+      CHARACTER*25 title
       REAL, ALLOCATABLE :: relief_hi(:,:)
       REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
+      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
       REAL, ALLOCATABLE :: tmp_var(:,:)
       INTEGER, ALLOCATABLE :: tmp_int(:,:)
@@ -274,17 +296,29 @@
     !
       ALLOCATE(lon_rad(iml_rel))
+      ALLOCATE(lon_ini(iml_rel))
+
       IF ( MAXVAL(lon_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_rad(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_rad(:) = lon_rel(:,1) 
-      ENDIF
+          lon_ini(:) = lon_rel(:,1) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lon_ini(:) = lon_rel(:,1) 
+      ENDIF
+
       ALLOCATE(lat_rad(jml_rel))
+      ALLOCATE(lat_ini(jml_rel))
+
       IF ( MAXVAL(lat_rel(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_rad(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_rad(:) = lat_rel(1,:) 
-      ENDIF
-    !
-    !
+          lat_ini(:) = lat_rel(1,:) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lat_ini(:) = lat_rel(1,:) 
+      ENDIF
+    !
+    !
+
+      title='RELIEF'
+
+      interbar2 = .FALSE.
+      CALL conf_dat2d(title,iml_rel, jml_rel, lon_ini, lat_ini,
+     . lon_rad, lat_rad, relief_hi , interbar2  )
+
       IF ( check ) WRITE(*,*) 'Computes all the parameters needed',
      .' for the gravity wave drag code'
@@ -312,10 +346,16 @@
       ALLOCATE(tmp_int(iml,jml))
       ALLOCATE(masque(iml,jml))
+
+      masque = -99999.
+      if (present(masque_lu)) then
+        masque = masque_lu
+      endif
     !
       CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi,
      . iml-1, jml, lon_in, lat_in, 
-     . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, tmp_int)
-    !
-      masque(:,:) = FLOAT(tmp_int(:,:))
+     . phis, relief, zstd, zsig, zgam, zthe, zpic, zval, masque)
+      phis = phis * 9.81
+    !
+!      masque(:,:) = FLOAT(tmp_int(:,:))
     !
     !  Compute surface roughness
@@ -336,4 +376,6 @@
         rugo(iml,j) = tmp_var(1,j)
       ENDDO
+c
+cc   ***   rugo  n'est pas utilise pour l'instant  ******
     !
     !   Build land-sea mask
@@ -347,11 +389,13 @@
     !
       SUBROUTINE startget_phys1d(varname, iml, jml, lon_in, 
-     .lat_in, nbindex, champ, val_exp)
+     .lat_in, nbindex, champ, val_exp ,jml2, lon_in2, lat_in2,interbar)
     !
       CHARACTER*(*), INTENT(in) :: varname
-      INTEGER, INTENT(in) :: iml, jml, nbindex
+      INTEGER, INTENT(in) :: iml, jml, nbindex, jml2
       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
+      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
       REAL, INTENT(inout) :: champ(nbindex)
       REAL, INTENT(in) :: val_exp
+      LOGICAL interbar
     !
     !
@@ -363,5 +407,6 @@
             CASE ('tsol')
               IF ( .NOT.ALLOCATED(tsol)) THEN
-                CALL start_init_phys( iml, jml, lon_in, lat_in)
+                CALL start_init_phys( iml, jml, lon_in, lat_in,
+     .              jml2, lon_in2, lat_in2, interbar )
               ENDIF
               IF ( SIZE(tsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -373,5 +418,6 @@
             CASE ('qsol')
               IF ( .NOT.ALLOCATED(qsol)) THEN
-                CALL start_init_phys( iml, jml, lon_in, lat_in)
+                CALL start_init_phys( iml, jml, lon_in, lat_in,
+     .              jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(qsol) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -383,5 +429,6 @@
             CASE ('psol')
               IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-                CALL start_init_dyn( iml, jml, lon_in, lat_in)
+                CALL start_init_dyn( iml, jml, lon_in, lat_in,
+     .              jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF (SIZE(psol_dyn) .NE. SIZE(lon_in)*SIZE(lat_in)) THEN
@@ -393,5 +440,6 @@
             CASE ('zmea')
               IF ( .NOT.ALLOCATED(relief)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .            jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(relief) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -403,5 +451,6 @@
             CASE ('zstd')
               IF ( .NOT.ALLOCATED(zstd)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .              jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(zstd) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -413,5 +462,6 @@
             CASE ('zsig')
               IF ( .NOT.ALLOCATED(zsig)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .               jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(zsig) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -423,5 +473,6 @@
             CASE ('zgam')
               IF ( .NOT.ALLOCATED(zgam)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .            jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(zgam) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -433,5 +484,6 @@
             CASE ('zthe')
               IF ( .NOT.ALLOCATED(zthe)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .            jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(zthe) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -443,5 +495,6 @@
             CASE ('zpic')
               IF ( .NOT.ALLOCATED(zpic)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .            jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(zpic) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -453,5 +506,6 @@
             CASE ('zval')
               IF ( .NOT.ALLOCATED(zval)) THEN
-                CALL start_init_orog( iml, jml, lon_in, lat_in)
+                CALL start_init_orog( iml, jml, lon_in, lat_in,
+     .            jml2, lon_in2,lat_in2 , interbar )
               ENDIF
               IF ( SIZE(zval) .NE. SIZE(lon_in)*SIZE(lat_in) ) THEN
@@ -461,5 +515,5 @@
               ENDIF
               CALL gr_dyn_fi(1, iml, jml, nbindex,zval, champ)
-             CASE ('rads')
+            CASE ('rads')
                   champ(:) = 0.0
             CASE ('snow')
@@ -492,20 +546,28 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !
-      SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in)
-    !
-      INTEGER, INTENT(in) :: iml, jml
+      SUBROUTINE start_init_phys( iml, jml, lon_in, lat_in, jml2,
+     .                 lon_in2, lat_in2 , interbar )
+    !
+      INTEGER, INTENT(in) :: iml, jml ,jml2
       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
+      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
+      LOGICAL interbar
     !
     !  LOCAL
     !
-      REAL :: lev(1), date, dt
+!ac     REAL :: lev(1), date, dt
+      REAL :: date, dt
+      REAL, DIMENSION(:), ALLOCATABLE :: levphys_ini
+!ac
       INTEGER :: itau(1)
       INTEGER ::  llm_tmp, ttm_tmp
       INTEGER :: i, j
     !
+      CHARACTER*25 title
       CHARACTER*120 :: physfname
       LOGICAL :: check=.TRUE.
     !
       REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
+      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
       REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:)
     !
@@ -517,12 +579,20 @@
      . ttm_tmp, fid_phys)
     !
-    !
       ALLOCATE (lat_phys(iml_phys,jml_phys))
       ALLOCATE (lon_phys(iml_phys,jml_phys))
+!ac
+      ALLOCATE (levphys_ini(llm_tmp))
+    !
+!      CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, 
+!     . llm_tmp, lon_phys, lat_phys, lev, ttm_tmp, 
+!     . itau, date, dt, fid_phys)
     !
       CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, 
-     . llm_tmp, lon_phys, lat_phys, lev, ttm_tmp, 
+     . llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp, 
      . itau, date, dt, fid_phys)
     !
+      DEALLOCATE (levphys_ini)
+!ac
+    !
     ! Allocate the space we will need to get the data out of this file
     !
@@ -532,15 +602,22 @@
     !
       ALLOCATE(lon_rad(iml_phys))
+      ALLOCATE(lon_ini(iml_phys))
+
       IF ( MAXVAL(lon_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_rad(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_rad(:) = lon_phys(:,1) 
-      ENDIF
+          lon_ini(:) = lon_phys(:,1) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lon_ini(:) = lon_phys(:,1) 
+      ENDIF
+
       ALLOCATE(lat_rad(jml_phys))
+      ALLOCATE(lat_ini(jml_phys))
+
       IF ( MAXVAL(lat_phys(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_rad(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_rad(:) = lat_phys(1,:) 
-      ENDIF
+          lat_ini(:) = lat_phys(1,:) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lat_ini(:) = lat_phys(1,:) 
+      ENDIF
+
+
     !
     !   We get the two standard varibales
@@ -551,8 +628,26 @@
     !
     !
+
       CALL flinget(fid_phys, 'ST', iml_phys, jml_phys, 
      .llm_tmp, ttm_tmp, 1, 1, var_ana)
-      CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
-     . var_ana, iml-1, jml, lon_in, lat_in, tmp_var)
+
+      title='ST'
+      CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
+     . lon_rad, lat_rad, var_ana , interbar  )
+
+      IF ( interbar )   THEN
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour  ST $$$ '
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
+     ,   var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var   ) 
+      ELSE
+        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
+     .    var_ana, iml-1, jml, lon_in, lat_in, tmp_var     )
+      ENDIF
+
       CALL gr_int_dyn(tmp_var, tsol, iml-1, jml)
     !
@@ -562,9 +657,26 @@
       CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys,
      . llm_tmp, ttm_tmp, 1, 1, var_ana)
-      CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
-     . var_ana, iml-1, jml, lon_in, lat_in, tmp_var)
-      CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
-    !
-      CALL flinclo(fid_phys)
+
+      title='CDSW'
+      CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini,
+     . lon_rad, lat_rad, var_ana, interbar  )
+
+      IF ( interbar )   THEN
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour  CDSW $$$ '
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        CALL inter_barxy ( iml_phys,jml_phys -1,lon_rad,lat_rad ,
+     ,   var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var  )
+      ELSE
+        CALL grille_m(iml_phys, jml_phys, lon_rad, lat_rad,
+     .    var_ana, iml-1, jml, lon_in, lat_in, tmp_var     )
+      ENDIF
+c
+        CALL gr_int_dyn(tmp_var, qsol, iml-1, jml)
+    !
+       CALL flinclo(fid_phys)
     !
       END SUBROUTINE start_init_phys
@@ -575,15 +687,18 @@
     !
       SUBROUTINE startget_dyn(varname, iml, jml, lon_in, lat_in,
-     . lml, pls, workvar, champ, val_exp)
+     . lml, pls, workvar, champ, val_exp,jml2, lon_in2, lat_in2 ,
+     ,  interbar )
     !
     !   ARGUMENTS
     !
       CHARACTER*(*), INTENT(in) :: varname
-      INTEGER, INTENT(in) :: iml, jml, lml
+      INTEGER, INTENT(in) :: iml, jml, lml, jml2
       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
+      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
       REAL, INTENT(in) :: pls(iml, jml, lml)
       REAL, INTENT(in) :: workvar(iml, jml, lml)
       REAL, INTENT(inout) :: champ(iml, jml, lml)
       REAL, INTENT(in) :: val_exp
+      LOGICAL interbar
     !
     !    LOCAL
@@ -591,7 +706,4 @@
       INTEGER :: il, ij, ii
       REAL :: xppn, xpps
-    !
-    !   C'est vraiment une galere de devoir rajouter tant de commons just pour avoir les aires.
-    !   Il faudrait mettre une structure plus flexible et moins dangereuse.
     !
 #include "dimensions.h"
@@ -608,8 +720,9 @@
           CASE ('u')
             IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in)
+              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
+     .          lon_in2,lat_in2 , interbar )
             ENDIF
             CALL start_inter_3d('U', iml, jml, lml, lon_in,
-     .                           lat_in, pls, champ)
+     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ,interbar )
             DO il=1,lml
               DO ij=1,jml
@@ -622,8 +735,9 @@
           CASE ('v')
             IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in)
+              CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2, 
+     .           lon_in2, lat_in2 , interbar )
             ENDIF
-            CALL start_inter_3d('V', iml, jml, lml, lon_in,
-     .                          lat_in, pls, champ)
+            CALL start_inter_3d('V', iml, jml, lml, lon_in, 
+     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
             DO il=1,lml
               DO ij=1,jml
@@ -636,15 +750,17 @@
           CASE ('t')
             IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in)
+              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
+     .           lon_in2, lat_in2 ,interbar )
             ENDIF
             CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
-     .                           lat_in, pls, champ)
+     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
  
           CASE ('tpot')
             IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in)
+              CALL start_init_dyn( iml, jml, lon_in, lat_in , jml2 ,
+     .            lon_in2, lat_in2 , interbar )
             ENDIF
             CALL start_inter_3d('TEMP', iml, jml, lml, lon_in,
-     .                           lat_in, pls, champ)
+     .       lat_in, jml2, lon_in2, lat_in2,  pls, champ, interbar )
             IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) )
      .                                    THEN
@@ -660,5 +776,5 @@
               DO il=1,lml
                 xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
-                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apoln
+                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
                 champ(:,1,il) = xppn
                 champ(:,jml,il) = xpps
@@ -671,8 +787,9 @@
           CASE ('q')
             IF ( .NOT.ALLOCATED(psol_dyn)) THEN
-              CALL start_init_dyn( iml, jml, lon_in, lat_in)
+              CALL start_init_dyn( iml, jml, lon_in, lat_in, jml2 ,
+     .           lon_in2, lat_in2 , interbar )
             ENDIF
             CALL start_inter_3d('R', iml, jml, lml, lon_in, lat_in,
-     .                           pls, champ)
+     .        jml2, lon_in2, lat_in2,  pls, champ, interbar )
             IF ( MINVAL(workvar(:,:,:)) .NE. MAXVAL(workvar(:,:,:)) ) 
      .                                     THEN
@@ -689,5 +806,5 @@
               DO il=1,lml
                 xppn = SUM(aire(:,1)*champ(:,1,il))/apoln
-                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apoln
+                xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
                 champ(:,1,il) = xppn
                 champ(:,jml,il) = xpps
@@ -709,8 +826,11 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !
-      SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in)
-    !
-      INTEGER, INTENT(in) :: iml, jml
+      SUBROUTINE start_init_dyn( iml, jml, lon_in, lat_in,jml2,lon_in2 ,
+     ,             lat_in2 , interbar )
+    !
+      INTEGER, INTENT(in) :: iml, jml, jml2
       REAL, INTENT(in) :: lon_in(iml), lat_in(jml)
+      REAL, INTENT(in) :: lon_in2(iml), lat_in2(jml2)
+      LOGICAL interbar
     !
     !  LOCAL
@@ -725,13 +845,16 @@
     !
       REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
+      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:)
       REAL, ALLOCATABLE :: var_ana(:,:), tmp_var(:,:), z(:,:)
       REAL, ALLOCATABLE :: xppn(:), xpps(:)
       LOGICAL :: allo
     !
-    !   Ce n'est pas tres pratique d'avoir a charger 3 include pour avoir la grille du modele
     !
 #include "dimensions.h"
 #include "paramet.h"
 #include "comgeom2.h"
+
+      CHARACTER*25 title
+
     !
       physfname = 'ECDYN.nc'
@@ -746,8 +869,8 @@
       ALLOCATE (lat_dyn(iml_dyn,jml_dyn), stat=iret)
       ALLOCATE (lon_dyn(iml_dyn,jml_dyn), stat=iret)
-      ALLOCATE (lev_dyn(llm_dyn), stat=iret)
+      ALLOCATE (levdyn_ini(llm_dyn), stat=iret)
     !
       CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn,
-     . lon_dyn, lat_dyn, lev_dyn, ttm_dyn, 
+     . lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, 
      . itau, date, dt, fid_dyn)
     !
@@ -763,18 +886,25 @@
         DEALLOCATE(lon_rad, stat=iret)
       endif
-        ALLOCATE(lon_rad(iml_dyn), stat=iret)
+
+      ALLOCATE(lon_rad(iml_dyn), stat=iret)
+      ALLOCATE(lon_ini(iml_dyn))
        
       IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_rad(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_rad(:) = lon_dyn(:,1) 
-      ENDIF
+          lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lon_ini(:) = lon_dyn(:,1) 
+      ENDIF
+
       ALLOCATE(lat_rad(jml_dyn))
+      ALLOCATE(lat_ini(jml_dyn))
+
       IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_rad(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_rad(:) = lat_dyn(1,:) 
-      ENDIF
-    !
+          lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lat_ini(:) = lat_dyn(1,:) 
+      ENDIF
+    !
+
+
       ALLOCATE(z(iml, jml))
       ALLOCATE(tmp_var(iml-1,jml))
@@ -782,6 +912,23 @@
       CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn,
      .              1, 1, var_ana)
-      CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
+c
+      title='Z'
+      CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
+     . lon_rad, lat_rad, var_ana, interbar  )
+c
+      IF ( interbar )   THEN
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour  Z  $$$ '
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
+     ,    var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var) 
+      ELSE
+        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
      .               iml-1, jml, lon_in, lat_in, tmp_var)
+      ENDIF
+
       CALL gr_int_dyn(tmp_var, z, iml-1, jml)
     !
@@ -790,6 +937,23 @@
       CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn,
      .              1, 1, var_ana)
-      CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
-     .               iml-1, jml, lon_in, lat_in, tmp_var)
+
+       title='SP'
+      CALL conf_dat2d( title,iml_dyn, jml_dyn,lon_ini, lat_ini,
+     . lon_rad, lat_rad, var_ana, interbar  )
+
+      IF ( interbar )   THEN
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour  SP  $$$ '
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        CALL inter_barxy ( iml_dyn,jml_dyn -1,lon_rad,lat_rad ,
+     ,    var_ana, iml-1, jml-1, lon_in2, lat_in2, jml, tmp_var) 
+      ELSE
+        CALL grille_m(iml_dyn, jml_dyn , lon_rad, lat_rad, var_ana,
+     .             iml-1, jml, lon_in, lat_in, tmp_var  )
+      ENDIF
+
       CALL gr_int_dyn(tmp_var, psol_dyn, iml-1, jml)
     !
@@ -799,5 +963,6 @@
     !   coming out of the restart file. In case we dor have it we will initialize it.
     !
-        CALL start_init_phys( iml, jml, lon_in, lat_in)
+        CALL start_init_phys( iml, jml, lon_in, lat_in,jml2,lon_in2,
+     .                 lat_in2 , interbar )
       ELSE
         IF ( SIZE(tsol) .NE. SIZE(psol_dyn) ) THEN
@@ -813,5 +978,6 @@
             !     coming out of the restart file. In case we dor have it we will initialize it.
             !
-          CALL start_init_orog( iml, jml, lon_in, lat_in)
+        CALL start_init_orog( iml, jml, lon_in, lat_in, jml2, lon_in2 ,
+     .      lat_in2 , interbar )
             !
       ELSE
@@ -859,5 +1025,5 @@
     !
       SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in,
-     .                           lat_in, pls_in, var3d)
+     .      lat_in, jml2, lon_in2, lat_in2, pls_in, var3d, interbar )
     !
     !    This subroutine gets a variables from a 3D file and does the interpolations needed
@@ -867,15 +1033,21 @@
     !
       CHARACTER*(*) :: varname
-      INTEGER :: iml, jml, lml
+      INTEGER :: iml, jml, lml, jml2
       REAL :: lon_in(iml), lat_in(jml), pls_in(iml, jml, lml)
+      REAL :: lon_in2(iml) , lat_in2(jml2)
       REAL :: var3d(iml, jml, lml)
+      LOGICAL interbar
+      real chmin,chmax
     !
     !  LOCAL
     !
-      INTEGER :: ii, ij, il
+      CHARACTER*25 title
+      INTEGER :: ii, ij, il, jsort,i,j,l
       REAL :: bx, by
       REAL, ALLOCATABLE :: lon_rad(:), lat_rad(:)
+      REAL, ALLOCATABLE :: lon_ini(:), lat_ini(:) , lev_dyn(:)
       REAL, ALLOCATABLE :: var_tmp2d(:,:), var_tmp3d(:,:,:)
       REAL, ALLOCATABLE :: ax(:), ay(:), yder(:)
+       REAL, ALLOCATABLE :: varrr(:,:,:)
       INTEGER, ALLOCATABLE :: lind(:)
     !
@@ -885,4 +1057,5 @@
           ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
       ENDIF
+          ALLOCATE(varrr(iml_dyn, jml_dyn, llm_dyn))
     !
     !
@@ -899,16 +1072,28 @@
     !
       ALLOCATE(lon_rad(iml_dyn))
+      ALLOCATE(lon_ini(iml_dyn))
+
       IF ( MAXVAL(lon_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lon_rad(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lon_rad(:) = lon_dyn(:,1) 
-      ENDIF
+          lon_ini(:) = lon_dyn(:,1) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lon_ini(:) = lon_dyn(:,1) 
+      ENDIF
+
       ALLOCATE(lat_rad(jml_dyn))
+      ALLOCATE(lat_ini(jml_dyn))
+
+      ALLOCATE(lev_dyn(llm_dyn))
+
       IF ( MAXVAL(lat_dyn(:,:)) .GT. 2.0 * ASIN(1.0) ) THEN
-          lat_rad(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
-      ELSE
-          lat_rad(:) = lat_dyn(1,:) 
-      ENDIF
-    !
+          lat_ini(:) = lat_dyn(1,:) * 2.0 * ASIN(1.0) / 180.0
+      ELSE
+          lat_ini(:) = lat_dyn(1,:) 
+      ENDIF
+    !
+
+      CALL conf_dat3d ( varname,iml_dyn, jml_dyn, llm_dyn, lon_ini, 
+     . lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d  ,
+     ,  interbar                                                   )
+
       ALLOCATE(var_tmp2d(iml-1, jml))
       ALLOCATE(var_tmp3d(iml, jml, llm_dyn))
@@ -918,8 +1103,22 @@
       ALLOCATE(lind(llm_dyn))
     !
+ 
       DO il=1,llm_dyn
         !
-        CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad, 
-     .var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d)
+      IF( interbar )  THEN
+       IF( il.EQ.1 )  THEN
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+        WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
+     , ' pour ', varname
+        WRITE(6,*) '-------------------------------------------------',
+     ,'--------------'
+       ENDIF
+       CALL inter_barxy ( iml_dyn, jml_dyn -1,lon_rad, lat_rad, 
+     , var_ana3d(:,:,il),iml-1, jml2, lon_in2, lat_in2,jml,var_tmp2d ) 
+      ELSE
+       CALL grille_m(iml_dyn, jml_dyn, lon_rad, lat_rad, 
+     .  var_ana3d(:,:,il), iml-1, jml, lon_in, lat_in, var_tmp2d )
+      ENDIF
         !
         CALL gr_int_dyn(var_tmp2d, var_tmp3d(:,:,il), iml-1, jml)
@@ -927,23 +1126,19 @@
        ENDDO
        !
-       !  IF needed we return the vertical axis. The spline interpolation
-       !  Requires the coordinate to be in increasing order.
-    !
-      IF ( lev_dyn(1) .LT. lev_dyn(llm_dyn)) THEN
-          DO il=1,llm_dyn
-            lind(il) = il
-          ENDDO        
-      ELSE
           DO il=1,llm_dyn
             lind(il) = llm_dyn-il+1
           ENDDO
-      ENDIF
-    !
+    !
+c
+c  ... Pour l'interpolation verticale ,on interpole du haut de l'atmosphere
+c                    vers  le  sol  ...
+c
       DO ij=1,jml
         DO ii=1,iml-1
           !
-          ax(:) = lev_dyn(lind(:)) * 100
+          ax(:) = lev_dyn(lind(:)) 
           ay(:) = var_tmp3d(ii, ij, lind(:))
           !
+         
           CALL SPLINE(ax, ay, llm_dyn, 1.e30, 1.e30, yder)
           !
@@ -958,4 +1153,18 @@
       ENDDO
 
+      do il=1,lml
+        call minmax(iml*jml,var3d(1,1,il),chmin,chmax)
+      SELECTCASE(varname)
+       CASE('U')
+          WRITE(*,*) ' U  min max l ',il,chmin,chmax
+       CASE('V')
+          WRITE(*,*) ' V  min max l ',il,chmin,chmax
+       CASE('TEMP')
+          WRITE(*,*) ' TEMP  min max l ',il,chmin,chmax
+       CASE('R')
+          WRITE(*,*) ' R  min max l ',il,chmin,chmax
+      END SELECT
+           enddo
+
       DEALLOCATE(lon_rad)
       DEALLOCATE(lat_rad)
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/temps.h
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/temps.h	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/temps.h	(revision 497)
@@ -1,11 +1,14 @@
-c-----------------------------------------------------------------------
-c INCLUDE 'temps.h'
+! $Header$
+!
+!-----------------------------------------------------------------------
+! INCLUDE 'temps.h'
 
-      COMMON/temps/itaufin,dt,
-     s  day_ini,day_end,anne_ini
+      COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,
+     .             itau_dyn, itau_phy
 
-      INTEGER  itaufin
-      INTEGER*4 day_ini,day_end,anne_ini
-      REAL     dt
+      INTEGER   itaufin
+      INTEGER*4 itau_dyn, itau_phy
+      INTEGER*4 day_ini, day_end, annee_ref, day_ref
+      REAL      dt
 
-c-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/temps.inc
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/temps.inc	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/temps.inc	(revision 497)
@@ -0,0 +1,15 @@
+!
+! $Header$
+!
+!-----------------------------------------------------------------------
+! INCLUDE 'temps.h'
+
+      COMMON/temps/itaufin, dt, &
+     &  day_ini, day_end, annee_ref, day_ref, itau_dyn, itau_phy
+
+      INTEGER  itaufin
+      INTEGER*4 itau_dyn, itau_phy
+      INTEGER*4 day_ini, day_end, annee_ref, day_ref
+      REAL     dt
+
+!-----------------------------------------------------------------------
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/tracvl.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/tracvl.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/tracvl.F	(revision 497)
@@ -1,4 +1,4 @@
       SUBROUTINE tracvl(numvanle,iapp_tracvl,nq,pbaru,pbarv ,
-     *                            p,  masse , q, iapptrac    )
+     *                    p, masse , q, iapptrac, iadv1, teta, pk  )
 c
 c     Auteur :  F. Hourdin
@@ -6,4 +6,6 @@
 c
 ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
+c                 F. Codron     (10/99)
+
 c
       IMPLICIT NONE
@@ -15,10 +17,15 @@
 #include "comgeom.h"
 
-      INTEGER nq,iapp_tracvl
+c     .... Arguments  ....
+c
+      INTEGER numvanle, nq, iapp_tracvl, iapptrac, iadv1
 
       REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
       REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
-      REAL p( ip1jmp1,llmp1 )
+      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
+      REAL pk(ip1jmp1,llm)
 
+c     ....  var. locales  .....
+c
       REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
       REAL massem(ip1jmp1,llm),zdp(ip1jmp1)
@@ -26,13 +33,13 @@
       REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
 
-      INTEGER iapptrac
 
-      INTEGER iadvtr, numvanle
+      INTEGER iadvtr, numvan
       INTEGER ij,l,iq
       REAL zdpmin, zdpmax
       EXTERNAL  minmax
- 
-      SAVE iadvtr, massem,pbaruc,pbarvc
+      SAVE iadvtr, massem, pbaruc, pbarvc, numvan
       DATA iadvtr/0/
+
+      numvan = numvanle
 
       IF(iadvtr.EQ.0) THEN
@@ -99,5 +106,14 @@
 
 c   Advection proprement dite.
-         DO iq = numvanle, nq
+c
+c   test sur iadv1 pour le schema de vapeur d'eau
+c
+         IF (numvanle.EQ.1.AND.iadv1.EQ.4) THEN
+           CALL vlspltqs( q(1,1,1), 2., massem, wg ,
+     *                 pbarug,pbarvg,dtvr,p,pk,teta )
+           numvan = 2
+         ENDIF
+
+         DO iq = numvan, nq
           CALL vlsplt( q(1,1,iq), 2. ,massem,wg,pbarug,pbarvg,dtvr )
          ENDDO
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vanleer.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/vanleer.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vanleer.F	(revision 497)
@@ -1,8 +1,10 @@
       SUBROUTINE vanleer(numvanle,iapp_tracvl,nq,q,pbaru,pbarv ,
-     *                                    p ,masse,  dq          )
+     *                     p ,masse, dq ,  iadv1, teta, pk      )
 c
       IMPLICIT NONE
 c
-c     Auteurs:   F.Hourdin , P.Le Van, F.Forget 
+c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron  
+c
+c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
 c=======================================================================
 c
@@ -18,8 +20,8 @@
 c   Arguments:
 c   ----------
-      INTEGER nq,numvanle,iapp_tracvl 
+      INTEGER nq, numvanle, iapp_tracvl, iadv1 
       REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
       REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nq),dq( ip1jmp1,llm,nq )
-
+      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
 c  ..................................................................
 c
@@ -28,4 +30,6 @@
 c     numvanle est le numero du premier traceur qui appelle le
 c       shema de Van-Leer  (  1<=  numvanle <=  nqmx )  .
+c     si numvanle=1, iadv1=3 si Van-Leer seul, iadv1=4 si 
+c     Van-Leer+humidite specifique.
 c  ..................................................................
 c
@@ -61,5 +65,5 @@
 
       CALL tracvl( numvanle,iapp_tracvl,nq,pbaru,pbarv,p , masse,q  ,
-     *                                iapptrac                       )
+     *                      iapptrac, iadv1, teta ,pk              )
 
       IF( numvanle.EQ.1 ) THEN
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vlsplt.F
===================================================================
--- LMDZ.3.3/branches/LF/libf/dyn3d/vlsplt.F	(revision 3)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vlsplt.F	(revision 497)
@@ -26,6 +26,8 @@
 c   ----------
       REAL masse(ip1jmp1,llm),pente_max
+c      REAL masse(iip1,jjp1,llm),pente_max
       REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
       REAL q(ip1jmp1,llm)
+c      REAL q(iip1,jjp1,llm)
       REAL w(ip1jmp1,llm),pdt
 c
@@ -33,16 +35,20 @@
 c   ---------
 c
-      INTEGER ij,l
-c
-      REAL zm(ip1jmp1,llm)
+      INTEGER i,ij,l,j,ii
+      INTEGER ijlqmin,iqmin,jqmin,lqmin
+c
+      REAL zm(ip1jmp1,llm),newmasse
       REAL mu(ip1jmp1,llm)
       REAL mv(ip1jm,llm)
       REAL mw(ip1jmp1,llm+1)
-      REAL zq(ip1jmp1,llm)
-      REAL temps1,temps2,temps3
+      REAL zq(ip1jmp1,llm),zz
+      REAL dqx(ip1jmp1,llm),dqy(ip1jmp1,llm),dqz(ip1jmp1,llm)
+      REAL second,temps0,temps1,temps2,temps3
+      REAL ztemps1,ztemps2,ztemps3
       REAL zzpbar, zzw
       LOGICAL testcpu
       SAVE testcpu
       SAVE temps1,temps2,temps3
+      INTEGER iminn,imaxx
 
       REAL qmin,qmax
@@ -51,5 +57,4 @@
       DATA temps1,temps2,temps3/0.,0.,0./
 
-c      PRINT*,'Debut vlsplt version debug sans vly'
 
         zzpbar = 0.5 * pdt
@@ -70,36 +75,29 @@
          mw(ij,llm+1)=0.
       ENDDO
-
+      
       CALL SCOPY(ijp1llm,q,1,zq,1)
       CALL SCOPY(ijp1llm,masse,1,zm,1)
 
-c      call minmaxq(zq,qmin,qmax,'avant vlx     ')
+c	print*,'Entree vlx1'
+c	call minmaxq(zq,qmin,qmax,'avant vlx     ')
       call vlx(zq,pente_max,zm,mu)
-
-
-c     call minmaxq(zq,qmin,qmax,'avant vly     ')
-
+C	print*,'Sortie vlx1'
+c	call minmaxq(zq,qmin,qmax,'apres vlx1    ')
+
+C	 print*,'Entree vly1'
       call vly(zq,pente_max,zm,mv)
-
-
-c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
-
+c	call minmaxq(zq,qmin,qmax,'apres vly1     ')
+C	print*,'Sortie vly1'
       call vlz(zq,pente_max,zm,mw)
-
-
-c     call minmaxq(zq,qmin,qmax,'avant vly     ')
-c     call minmaxq(zm,qmin,qmax,'M avant vly     ')
+c	call minmaxq(zq,qmin,qmax,'apres vlz     ')
+
 
       call vly(zq,pente_max,zm,mv)
-
-
-c     call minmaxq(zq,qmin,qmax,'avant vlx     ')
-c     call minmaxq(zm,qmin,qmax,'M avant vlx     ')
+c	call minmaxq(zq,qmin,qmax,'apres vly     ')
+
 
       call vlx(zq,pente_max,zm,mu)
-
-c     call minmaxq(zq,qmin,qmax,'apres vlx     ')
-c     call minmaxq(zm,qmin,qmax,'M apres vlx     ')
-
+c	call minmaxq(zq,qmin,qmax,'apres vlx2    ')
+	
 
       DO l=1,llm
@@ -115,5 +113,5 @@
       END
       SUBROUTINE vlx(q,pente_max,masse,u_m)
-c
+
 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
 c
@@ -137,6 +135,7 @@
 c   ----------
       REAL masse(ip1jmp1,llm),pente_max
-      REAL u_m( ip1jmp1,llm )
+      REAL u_m( ip1jmp1,llm ),pbarv( iip1,jjm,llm)
       REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm)
 c
 c      Local 
@@ -147,17 +146,18 @@
 c
       REAL new_m,zu_m,zdum(ip1jmp1,llm)
-      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL sigu(ip1jmp1),dxq(ip1jmp1,llm),dxqu(ip1jmp1)
       REAL zz(ip1jmp1)
       REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
       REAL u_mq(ip1jmp1,llm)
 
-      Logical first,testcpu
+      Logical extremum,first,testcpu
       SAVE first,testcpu
 
       REAL      SSUM
       EXTERNAL  SSUM
-      REAL temps1,temps2,temps3,temps4,temps5
-      SAVE temps1,temps2,temps3,temps4,temps5
-
+      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+
+      REAL z1,z2,z3
 
       DATA first,testcpu/.true.,.false./
@@ -176,5 +176,5 @@
 
       IF (pente_max.gt.-1.e-5) THEN
-c     IF (pente_max.gt.10) THEN
+c       IF (pente_max.gt.10) THEN
 
 c   calcul des pentes avec limitation, Van Leer scheme I:
@@ -230,4 +230,5 @@
 
          ENDDO ! l=1,llm
+C	print*,'Ok calcul des pentes'
 
       ELSE ! (pente_max.lt.-1.e-5)
@@ -266,5 +267,4 @@
             dxq(ij-iim,l)=dxq(ij,l)
          ENDDO
-
          DO ij=1,ip1jmp1
             iadvplus(ij,l)=0
@@ -273,4 +273,5 @@
       ENDDO
 
+c	 print*,'Bouclage en iip1'
 
 c   calcul des flux a gauche et a droite
@@ -294,6 +295,9 @@
 c   on cumule le flux correspondant a toutes les mailles dont la masse
 c   au travers de la paroi pENDant le pas de temps.
+C	print*,'Cumule ....'
+
       DO l=1,llm
        DO ij=iip2,ip1jm-1
+Cc	print*,'masse(',ij,')=',masse(ij,l)
           IF (u_m(ij,l).gt.0.) THEN
              zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
@@ -306,6 +310,7 @@
       ENDDO
 #endif
-
-
+c	stop
+
+c	go to 9999
 c   detection des points ou on advecte plus que la masse de la
 c   maille
@@ -318,4 +323,5 @@
          ENDDO
       ENDDO
+C	print*,'Ok test 1'
       DO l=1,llm
        DO ij=iip1+iip1,ip1jm,iip1
@@ -323,5 +329,5 @@
        ENDDO
       ENDDO
-
+C	 print*,'Ok test 2'
 
 
@@ -342,6 +348,6 @@
 
       IF(n0.gt.1) THEN
-ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
-ccc     &       ,'contenu de la maille : ',n0
+c     PRINT*,'Nombre de points pour lesquels on advect plus que le'
+c    &       ,'contenu de la maille : ',n0
 
          DO l=1,llm
@@ -395,9 +401,9 @@
          ENDDO
       ENDIF  ! n0.gt.0 
-
+9999    continue
 
 
 c   bouclage en latitude
-
+C	print*,'Avant bouclage en latitude'
       DO l=1,llm
         DO ij=iip1+iip1,ip1jm,iip1
@@ -423,5 +429,4 @@
          ENDDO
       ENDDO
-
 c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
 c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
@@ -456,5 +461,5 @@
       REAL masse(ip1jmp1,llm),pente_max
       REAL masse_adv_v( ip1jm,llm)
-      REAL q(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm), dq( ip1jmp1,llm)
 c
 c      Local 
@@ -464,16 +469,17 @@
 c
       REAL airej2,airejjm,airescb(iim),airesch(iim)
-      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm),zdvm(ip1jmp1,llm)
       REAL adyqv(ip1jm),dyqmax(ip1jmp1)
       REAL qbyv(ip1jm,llm)
 
-      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+      REAL qpns,qpsn,apn,aps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
 c     REAL newq,oldmasse
-      Logical first,testcpu
-      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      Logical extremum,first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
       SAVE temps0,temps1,temps2,temps3,temps4,temps5
       SAVE first,testcpu
 
       REAL convpn,convps,convmpn,convmps
+      real massepn,masseps,qpn,qps
       REAL sinlon(iip1),sinlondlon(iip1)
       REAL coslon(iip1),coslondlon(iip1)
@@ -506,5 +512,5 @@
 
 c
-
+c	PRINT*,'CALCUL EN LATITUDE'
 
       DO l = 1, llm
@@ -565,4 +571,5 @@
 c   calcul des pentes limites aux poles
 
+      goto 8888
       fn=1.
       fs=1.
@@ -578,4 +585,9 @@
          dyq(ij,l)=fn*dyq(ij,l)
          dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+8888    continue
+      DO ij=1,iip1
+         dyq(ij,l)=0.
+         dyq(ip1jm+ij,l)=0.
       ENDDO
 
@@ -682,20 +694,34 @@
          ENDDO
 c.-. ancienne version
-         convpn=SSUM(iim,qbyv(1,l),1)/apoln
-         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
-         DO ij = 1,iip1
-            newmasse=masse(ij,l)+convmpn*aire(ij)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
-     &               newmasse
-            masse(ij,l)=newmasse
-         ENDDO
-         convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
-         convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)/apols
-         DO ij = ip1jm+1,ip1jmp1
-            newmasse=masse(ij,l)+convmps*aire(ij)
-            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
-     &               newmasse
-            masse(ij,l)=newmasse
-         ENDDO
+c        convpn=SSUM(iim,qbyv(1,l),1)/apoln
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+
+         convpn=SSUM(iim,qbyv(1,l),1)
+         convmpn=ssum(iim,masse_adv_v(1,l),1)
+         massepn=ssum(iim,masse(1,l),1)
+         qpn=0.
+         do ij=1,iim
+            qpn=qpn+masse(ij,l)*q(ij,l)
+         enddo
+         qpn=(qpn+convpn)/(massepn+convmpn)
+         do ij=1,iip1
+            q(ij,l)=qpn
+         enddo
+
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+
+         convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+         convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+         masseps=ssum(iim, masse(ip1jm+1,l),1)
+         qps=0.
+         do ij = ip1jm+1,ip1jmp1-1
+            qps=qps+masse(ij,l)*q(ij,l)
+         enddo
+         qps=(qps+convps)/(masseps+convmps)
+         do ij=ip1jm+1,ip1jmp1
+            q(ij,l)=qps
+         enddo
+
 c.-. fin ancienne version
 
@@ -852,32 +878,76 @@
       RETURN
       END
-      SUBROUTINE minmaxq(zq,qmin,qmax,comment)
+c      SUBROUTINE minmaxq(zq,qmin,qmax,comment)
+c
+c#include "dimensions.h"
+c#include "paramet.h"
+
+c      CHARACTER*(*) comment
+c      real qmin,qmax
+c      real zq(ip1jmp1,llm)
+
+c      INTEGER jadrs(ip1jmp1), jbad, k, i
+
+
+c      DO k = 1, llm
+c         jbad = 0
+c         DO i = 1, ip1jmp1
+c         IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
+c            jbad = jbad + 1
+c            jadrs(jbad) = i
+c         ENDIF
+c         ENDDO
+c         IF (jbad.GT.0) THEN
+c         PRINT*, comment
+c         DO i = 1, jbad
+cc            PRINT*, "i,k,zq=", jadrs(i),k,zq(jadrs(i),k)
+c         ENDDO
+c         ENDIF
+c      ENDDO
+
+c      return
+c      end
+      subroutine minmaxq(zq,qmin,qmax,comment)
 
 #include "dimensions.h"
 #include "paramet.h"
 
-      CHARACTER*(*) comment
+      character*20 comment
       real qmin,qmax
       real zq(ip1jmp1,llm)
-
-      INTEGER jadrs(ip1jmp1), jbad, k, i
-
-      DO k = 1, llm
-         jbad = 0
-         DO i = 1, ip1jmp1
-         IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN
-            jbad = jbad + 1
-            jadrs(jbad) = i
-         ENDIF
-         ENDDO
-         IF (jbad.GT.0) THEN
-         PRINT*, comment
-         DO i = 1, jbad
-cc            PRINT*, "i,k,zq=", jadrs(i),k,zq(jadrs(i),k)
-         ENDDO
-         ENDIF
-      ENDDO
+      real zzq(iip1,jjp1,llm)
+
+      integer imin,jmin,lmin,ijlmin
+      integer imax,jmax,lmax,ijlmax
+
+      integer ismin,ismax
+
+      call scopy (ip1jmp1*llm,zq,1,zzq,1)
+
+      ijlmin=ismin(ijp1llm,zq,1)
+      lmin=(ijlmin-1)/ip1jmp1+1
+      ijlmin=ijlmin-(lmin-1.)*ip1jmp1
+      jmin=(ijlmin-1)/iip1+1
+      imin=ijlmin-(jmin-1.)*iip1
+      zqmin=zq(ijlmin,lmin)
+
+      ijlmax=ismax(ijp1llm,zq,1)
+      lmax=(ijlmax-1)/ip1jmp1+1
+      ijlmax=ijlmax-(lmax-1.)*ip1jmp1
+      jmax=(ijlmax-1)/iip1+1
+      imax=ijlmax-(jmax-1.)*iip1
+      zqmax=zq(ijlmax,lmax)
+
+       if(zqmin.lt.qmin) 
+c     s     write(*,9999) comment,
+     s     write(*,*) comment,
+     s     imin,jmin,lmin,zqmin,zzq(imin,jmin,lmin)
+       if(zqmax.gt.qmax) 
+c     s     write(*,9999) comment,
+     s     write(*,*) comment,
+     s     imax,jmax,lmax,zqmax,zzq(imax,jmax,lmax)
 
       return
+9999  format(a20,'  q(',i3,',',i2,',',i2,')=',e12.5,e12.5)
       end
 
Index: LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vlspltqs.F
===================================================================
--- LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vlspltqs.F	(revision 497)
+++ LMDZ.3.3/tags/IPSL-CM4_LJ29_OPT/libf/dyn3d/vlspltqs.F	(revision 497)
@@ -0,0 +1,774 @@
+       SUBROUTINE vlspltqs ( q,pente_max,masse,w,pbaru,pbarv,pdt,
+     ,                                  p,pk,teta                 )
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron 
+c
+c    ********************************************************************
+c          Shema  d'advection " pseudo amont " .
+c      + test sur humidite specifique: Q advecte< Qsat aval
+c                   (F. Codron, 10/99)
+c    ********************************************************************
+c     q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
+c
+c     pente_max facteur de limitation des pentes: 2 en general
+c                                                0 pour un schema amont
+c     pbaru,pbarv,w flux de masse en u ,v ,w
+c     pdt pas de temps
+c
+c     teta temperature potentielle, p pression aux interfaces,
+c     pk exner au milieu des couches necessaire pour calculer Qsat
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL w(ip1jmp1,llm),pdt
+      REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l,j,ii
+c
+      REAL qsat(ip1jmp1,llm)
+      REAL zm(ip1jmp1,llm)
+      REAL mu(ip1jmp1,llm)
+      REAL mv(ip1jm,llm)
+      REAL mw(ip1jmp1,llm+1)
+      REAL zq(ip1jmp1,llm)
+      REAL temps1,temps2,temps3
+      REAL zzpbar, zzw
+      LOGICAL testcpu
+      SAVE testcpu
+      SAVE temps1,temps2,temps3
+
+      REAL qmin,qmax
+      DATA qmin,qmax/0.,1.e33/
+      DATA testcpu/.false./
+      DATA temps1,temps2,temps3/0.,0.,0./
+
+c--pour rapport de melange saturant--
+
+      REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
+      REAL ptarg,pdelarg,foeew,zdelta
+      REAL tempe(ip1jmp1)
+
+c    fonction psat(T)
+
+       FOEEW ( PTARG,PDELARG ) = EXP (
+     *          (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT)
+     * / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+
+        r2es  = 380.11733 
+        r3les = 17.269
+        r3ies = 21.875
+        r4les = 35.86
+        r4ies = 7.66
+        retv = 0.6077667
+        rtt  = 273.16
+
+c-- Calcul de Qsat en chaque point
+c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
+c   pour eviter une exponentielle.
+        DO l = 1, llm
+         DO ij = 1, ip1jmp1
+          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
+         ENDDO
+         DO ij = 1, ip1jmp1
+          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
+          play   = 0.5*(p(ij,l)+p(ij,l+1))
+          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
+          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
+         ENDDO
+        ENDDO
+
+c      PRINT*,'Debut vlsplt version debug sans vlyqs'
+
+        zzpbar = 0.5 * pdt
+        zzw    = pdt
+      DO l=1,llm
+        DO ij = iip2,ip1jm
+            mu(ij,l)=pbaru(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jm
+            mv(ij,l)=pbarv(ij,l) * zzpbar
+         ENDDO
+         DO ij=1,ip1jmp1
+            mw(ij,l)=w(ij,l) * zzw
+         ENDDO
+      ENDDO
+
+      DO ij=1,ip1jmp1
+         mw(ij,llm+1)=0.
+      ENDDO
+
+      CALL SCOPY(ijp1llm,q,1,zq,1)
+      CALL SCOPY(ijp1llm,masse,1,zm,1)
+
+c      call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c      call minmaxq(zq,qmin,qmax,'avant vlz     ')
+
+      call vlz(zq,pente_max,zm,mw)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlyqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlyqs     ')
+
+      call vlyqs(zq,pente_max,zm,mv,qsat)
+
+
+c     call minmaxq(zq,qmin,qmax,'avant vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M avant vlxqs     ')
+
+      call vlxqs(zq,pente_max,zm,mu,qsat)
+
+c     call minmaxq(zq,qmin,qmax,'apres vlxqs     ')
+c     call minmaxq(zm,qmin,qmax,'M apres vlxqs     ')
+
+
+      DO l=1,llm
+         DO ij=1,ip1jmp1
+           q(ij,l)=zq(ij,l)
+         ENDDO
+         DO ij=1,ip1jm+1,iip1
+            q(ij+iim,l)=q(ij,l)
+         ENDDO
+      ENDDO
+
+      RETURN
+      END
+      SUBROUTINE vlxqs(q,pente_max,masse,u_m,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL u_m( ip1jmp1,llm )
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
+      INTEGER n0,iadvplus(ip1jmp1,llm),nl(llm)
+c
+      REAL new_m,zu_m,zdum(ip1jmp1,llm)
+      REAL dxq(ip1jmp1,llm),dxqu(ip1jmp1)
+      REAL zz(ip1jmp1)
+      REAL adxqu(ip1jmp1),dxqmax(ip1jmp1,llm)
+      REAL u_mq(ip1jmp1,llm)
+
+      Logical first,testcpu
+      SAVE first,testcpu
+
+      REAL      SSUM
+      EXTERNAL  SSUM
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+
+
+      DATA first,testcpu/.true.,.false./
+
+      IF(first) THEN
+         temps1=0.
+         temps2=0.
+         temps3=0.
+         temps4=0.
+         temps5=0.
+         first=.false.
+      ENDIF
+
+c   calcul de la pente a droite et a gauche de la maille
+
+
+      IF (pente_max.gt.-1.e-5) THEN
+c     IF (pente_max.gt.10) THEN
+
+c   calcul des pentes avec limitation, Van Leer scheme I:
+c   -----------------------------------------------------
+
+c   calcul de la pente aux points u
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+c              IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'
+c              sigu(ij)=u_m(ij,l)/masse(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+c              sigu(ij)=sigu(ij-iim)
+            ENDDO
+
+            DO ij=iip2,ip1jm
+               adxqu(ij)=abs(dxqu(ij))
+            ENDDO
+
+c   calcul de la pente maximum dans la maille en valeur absolue
+
+            DO ij=iip2+1,ip1jm
+               dxqmax(ij,l)=pente_max*
+     ,      min(adxqu(ij-1),adxqu(ij))
+c limitation subtile
+c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
+          
+
+            ENDDO
+
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqmax(ij-iim,l)=dxqmax(ij,l)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+#ifdef CRAY
+               dxq(ij,l)=
+     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
+#else
+               IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
+                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+#endif
+               dxq(ij,l)=0.5*dxq(ij,l)
+               dxq(ij,l)=
+     ,         sign(min(abs(dxq(ij,l)),dxqmax(ij,l)),dxq(ij,l))
+            ENDDO
+
+         ENDDO ! l=1,llm
+
+      ELSE ! (pente_max.lt.-1.e-5)
+
+c   Pentes produits:
+c   ----------------
+
+         DO l = 1, llm
+            DO ij=iip2,ip1jm-1
+               dxqu(ij)=q(ij+1,l)-q(ij,l)
+            ENDDO
+            DO ij=iip1+iip1,ip1jm,iip1
+               dxqu(ij)=dxqu(ij-iim)
+            ENDDO
+
+            DO ij=iip2+1,ip1jm
+               zz(ij)=dxqu(ij-1)*dxqu(ij)
+               zz(ij)=zz(ij)+zz(ij)
+               IF(zz(ij).gt.0) THEN
+                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
+               ELSE
+c   extremum local
+                  dxq(ij,l)=0.
+               ENDIF
+            ENDDO
+
+         ENDDO
+
+      ENDIF ! (pente_max.lt.-1.e-5)
+
+c   bouclage de la pente en iip1:
+c   -----------------------------
+
+      DO l=1,llm
+         DO ij=iip1+iip1,ip1jm,iip1
+            dxq(ij-iim,l)=dxq(ij,l)
+         ENDDO
+
+         DO ij=1,ip1jmp1
+            iadvplus(ij,l)=0
+         ENDDO
+
+      ENDDO
+
+
+c   calcul des flux a gauche et a droite
+
+#ifdef CRAY
+c--pas encore modification sur Qsat
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l),
+     ,                     1.+u_m(ij,l)/masse(ij+1,l),
+     ,                     u_m(ij,l))
+          zdum(ij,l)=0.5*zdum(ij,l)
+          u_mq(ij,l)=cvmgp(
+     ,                q(ij,l)+zdum(ij,l)*dxq(ij,l),
+     ,                q(ij+1,l)-zdum(ij,l)*dxq(ij+1,l),
+     ,                u_m(ij,l))
+          u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
+       ENDDO
+      ENDDO
+#else
+c   on cumule le flux correspondant a toutes les mailles dont la masse
+c   au travers de la paroi pENDant le pas de temps.
+c   le rapport de melange de l'air advecte est min(q_vanleer, Qsat_downwind)
+      DO l=1,llm
+       DO ij=iip2,ip1jm-1
+          IF (u_m(ij,l).gt.0.) THEN
+             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij,l)+0.5*zdum(ij,l)*dxq(ij,l),qsat(ij+1,l))
+          ELSE
+             zdum(ij,l)=1.+u_m(ij,l)/masse(ij+1,l)
+             u_mq(ij,l)=u_m(ij,l)*
+     $         min(q(ij+1,l)-0.5*zdum(ij,l)*dxq(ij+1,l),qsat(ij,l))
+          ENDIF
+       ENDDO
+      ENDDO
+#endif
+
+
+c   detection des points ou on advecte plus que la masse de la
+c   maille
+      DO l=1,llm
+         DO ij=iip2,ip1jm-1
+            IF(zdum(ij,l).lt.0) THEN
+               iadvplus(ij,l)=1
+               u_mq(ij,l)=0.
+            ENDIF
+         ENDDO
+      ENDDO
+      DO l=1,llm
+       DO ij=iip1+iip1,ip1jm,iip1
+          iadvplus(ij,l)=iadvplus(ij-iim,l)
+       ENDDO
+      ENDDO
+
+
+
+c   traitement special pour le cas ou on advecte en longitude plus que le
+c   contenu de la maille.
+c   cette partie est mal vectorisee.
+
+c   pas d'influence de la pression saturante (pour l'instant)
+
+c  calcul du nombre de maille sur lequel on advecte plus que la maille.
+
+      n0=0
+      DO l=1,llm
+         nl(l)=0
+         DO ij=iip2,ip1jm
+            nl(l)=nl(l)+iadvplus(ij,l)
+         ENDDO
+         n0=n0+nl(l)
+      ENDDO
+
+      IF(n0.gt.1) THEN
+ccc      PRINT*,'Nombre de points pour lesquels on advect plus que le'
+ccc     &       ,'contenu de la maille : ',n0
+
+         DO l=1,llm
+            IF(nl(l).gt.0) THEN
+               iju=0
+c   indicage des mailles concernees par le traitement special
+               DO ij=iip2,ip1jm
+                  IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
+                     iju=iju+1
+                     indu(iju)=ij
+                  ENDIF
+               ENDDO
+               niju=iju
+c              PRINT*,'niju,nl',niju,nl(l)
+
+c  traitement des mailles
+               DO iju=1,niju
+                  ij=indu(iju)
+                  j=(ij-1)/iip1+1
+                  zu_m=u_m(ij,l)
+                  u_mq(ij,l)=0.
+                  IF(zu_m.gt.0.) THEN
+                     ijq=ij
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m-masse(ijq,l)
+                        i=mod(i-2+iim,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*
+     &               (q(ijq,l)+0.5*(1.-zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ELSE
+                     ijq=ij+1
+                     i=ijq-(j-1)*iip1
+c   accumulation pour les mailles completements advectees
+                     do while(-zu_m.gt.masse(ijq,l))
+                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l)*masse(ijq,l)
+                        zu_m=zu_m+masse(ijq,l)
+                        i=mod(i,iim)+1
+                        ijq=(j-1)*iip1+i
+                     ENDDO
+c   ajout de la maille non completement advectee
+                     u_mq(ij,l)=u_mq(ij,l)+zu_m*(q(ijq,l)-
+     &               0.5*(1.+zu_m/masse(ijq,l))*dxq(ijq,l))
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF  ! n0.gt.0 
+
+
+
+c   bouclage en latitude
+
+      DO l=1,llm
+        DO ij=iip1+iip1,ip1jm,iip1
+           u_mq(ij,l)=u_mq(ij-iim,l)
+        ENDDO
+      ENDDO
+
+
+c   calcul des tendances
+
+      DO l=1,llm
+         DO ij=iip2+1,ip1jm
+            new_m=masse(ij,l)+u_m(ij-1,l)-u_m(ij,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+
+     &      u_mq(ij-1,l)-u_mq(ij,l))
+     &      /new_m
+            masse(ij,l)=new_m
+         ENDDO
+c   Modif Fred 22 03 96 correction d'un bug (les scopy ci-dessous)
+         DO ij=iip1+iip1,ip1jm,iip1
+            q(ij-iim,l)=q(ij,l)
+            masse(ij-iim,l)=masse(ij,l)
+         ENDDO
+      ENDDO
+
+c     CALL SCOPY((jjm-1)*llm,q(iip1+iip1,1),iip1,q(iip2,1),iip1)
+c     CALL SCOPY((jjm-1)*llm,masse(iip1+iip1,1),iip1,masse(iip2,1),iip1)
+
+
+      RETURN
+      END
+      SUBROUTINE vlyqs(q,pente_max,masse,masse_adv_v,qsat)
+c
+c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
+c
+c    ********************************************************************
+c     Shema  d'advection " pseudo amont " .
+c    ********************************************************************
+c     q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
+c     qsat 	       est   un argument de sortie pour le s-pg ....
+c
+c
+c   --------------------------------------------------------------------
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "logic.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "comgeom.h"
+c
+c
+c   Arguments:
+c   ----------
+      REAL masse(ip1jmp1,llm),pente_max
+      REAL masse_adv_v( ip1jm,llm)
+      REAL q(ip1jmp1,llm)
+      REAL qsat(ip1jmp1,llm)
+c
+c      Local 
+c   ---------
+c
+      INTEGER i,ij,l
+c
+      REAL airej2,airejjm,airescb(iim),airesch(iim)
+      REAL dyq(ip1jmp1,llm),dyqv(ip1jm)
+      REAL adyqv(ip1jm),dyqmax(ip1jmp1)
+      REAL qbyv(ip1jm,llm)
+
+      REAL qpns,qpsn,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+c     REAL newq,oldmasse
+      Logical first,testcpu
+      REAL temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE temps0,temps1,temps2,temps3,temps4,temps5
+      SAVE first,testcpu
+
+      REAL convpn,convps,convmpn,convmps
+      REAL sinlon(iip1),sinlondlon(iip1)
+      REAL coslon(iip1),coslondlon(iip1)
+      SAVE sinlon,coslon,sinlondlon,coslondlon
+      SAVE airej2,airejjm
+c
+c
+      REAL      SSUM
+      EXTERNAL  SSUM
+
+      DATA first,testcpu/.true.,.false./
+      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
+
+      IF(first) THEN
+         PRINT*,'Shema  Amont nouveau  appele dans  Vanleer   '
+         first=.false.
+         do i=2,iip1
+            coslon(i)=cos(rlonv(i))
+            sinlon(i)=sin(rlonv(i))
+            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
+            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
+         ENDDO
+         coslon(1)=coslon(iip1)
+         coslondlon(1)=coslondlon(iip1)
+         sinlon(1)=sinlon(iip1)
+         sinlondlon(1)=sinlondlon(iip1)
+         airej2 = SSUM( iim, aire(iip2), 1 )
+         airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
+      ENDIF
+
+c
+
+
+      DO l = 1, llm
+c
+c   --------------------------------
+c      CALCUL EN LATITUDE
+c   --------------------------------
+
+c   On commence par calculer la valeur du traceur moyenne sur le premier cercle
+c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
+c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
+
+      DO i = 1, iim
+      airescb(i) = aire(i+ iip1) * q(i+ iip1,l)
+      airesch(i) = aire(i+ ip1jm- iip1) * q(i+ ip1jm- iip1,l)
+      ENDDO
+      qpns   = SSUM( iim,  airescb ,1 ) / airej2
+      qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
+
+c   calcul des pentes aux points v
+
+      DO ij=1,ip1jm
+         dyqv(ij)=q(ij,l)-q(ij+iip1,l)
+         adyqv(ij)=abs(dyqv(ij))
+      ENDDO
+
+c   calcul des pentes aux points scalaires
+
+      DO ij=iip2,ip1jm
+         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
+         dyqmax(ij)=min(adyqv(ij-iip1),adyqv(ij))
+         dyqmax(ij)=pente_max*dyqmax(ij)
+      ENDDO
+
+c   calcul des pentes aux poles
+
+      DO ij=1,iip1
+         dyq(ij,l)=qpns-q(ij+iip1,l)
+         dyq(ip1jm+ij,l)=q(ip1jm+ij-iip1,l)-qpsn
+      ENDDO
+
+c   filtrage de la derivee
+      dyn1=0.
+      dys1=0.
+      dyn2=0.
+      dys2=0.
+      DO ij=1,iim
+         dyn1=dyn1+sinlondlon(ij)*dyq(ij,l)
+         dys1=dys1+sinlondlon(ij)*dyq(ip1jm+ij,l)
+         dyn2=dyn2+coslondlon(ij)*dyq(ij,l)
+         dys2=dys2+coslondlon(ij)*dyq(ip1jm+ij,l)
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
+         dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
+      ENDDO
+
+c   calcul des pentes limites aux poles
+
+      fn=1.
+      fs=1.
+      DO ij=1,iim
+         IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
+            fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn)
+         ENDIF
+      IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
+         fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs)
+         ENDIF
+      ENDDO
+      DO ij=1,iip1
+         dyq(ij,l)=fn*dyq(ij,l)
+         dyq(ip1jm+ij,l)=fs*dyq(ip1jm+ij,l)
+      ENDDO
+
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C  En memoire de dIFferents tests sur la 
+C  limitation des pentes aux poles.
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C     PRINT*,dyq(1)
+C     PRINT*,dyqv(iip1+1)
+C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     PRINT*,dyq(ip1jm+1)
+C     PRINT*,dyqv(ip1jm-iip1+1)
+C     aps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
+C     DO ij=2,iim
+C        apn=amax1(abs(dyq(ij)/dyqv(ij)),apn)
+C        aps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),aps)
+C     ENDDO
+C     apn=min(pente_max/apn,1.)
+C     aps=min(pente_max/aps,1.)
+C
+C
+C   cas ou on a un extremum au pole
+C
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   apn=0.
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &   aps=0.
+C
+C   limitation des pentes aux poles
+C     DO ij=1,iip1
+C        dyq(ij)=apn*dyq(ij)
+C        dyq(ip1jm+ij)=aps*dyq(ip1jm+ij)
+C     ENDDO
+C
+C   test
+C      DO ij=1,iip1
+C         dyq(iip1+ij)=0.
+C         dyq(ip1jm+ij-iip1)=0.
+C      ENDDO
+C      DO ij=1,ip1jmp1
+C         dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
+C      ENDDO
+C
+C changement 10 07 96
+C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
+C    &   THEN
+C        DO ij=1,iip1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=1,iip1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij))
+C        ENDDO
+C     ENDIF
+C
+C     IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
+C    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
+C    &THEN
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=0.
+C        ENDDO
+C     ELSE
+C        DO ij=ip1jm+1,ip1jmp1
+C           dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
+C        ENDDO
+C     ENDIF
+C   fin changement 10 07 96
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+
+c   calcul des pentes limitees
+
+      DO ij=iip2,ip1jm
+         IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
+            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
+         ELSE
+            dyq(ij,l)=0.
+         ENDIF
+      ENDDO
+
+      ENDDO
+
+      DO l=1,llm
+       DO ij=1,ip1jm
+         IF( masse_adv_v(ij,l).GT.0. ) THEN
+           qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l )  +
+     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)/masse(ij+iip1,l)))
+         ELSE
+              qbyv(ij,l)= MIN( qsat(ij,l), q(ij,l) - dyq(ij,l) *
+     ,                   0.5*(1.+masse_adv_v(ij,l)/masse(ij,l)) )
+         ENDIF
+          qbyv(ij,l) = masse_adv_v(ij,l)*qbyv(ij,l)
+       ENDDO
+      ENDDO
+
+
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+            newmasse=masse(ij,l)
+     &      +masse_adv_v(ij,l)-masse_adv_v(ij-iip1,l)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+qbyv(ij,l)-qbyv(ij-iip1,l))
+     &         /newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. ancienne version
+         convpn=SSUM(iim,qbyv(1,l),1)/apoln
+         convmpn=ssum(iim,masse_adv_v(1,l),1)/apoln
+         DO ij = 1,iip1
+            newmasse=masse(ij,l)+convmpn*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convpn*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+         convps  = -SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
+         convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
+         DO ij = ip1jm+1,ip1jmp1
+            newmasse=masse(ij,l)+convmps*aire(ij)
+            q(ij,l)=(q(ij,l)*masse(ij,l)+convps*aire(ij))/
+     &               newmasse
+            masse(ij,l)=newmasse
+         ENDDO
+c.-. fin ancienne version
+
+c._. nouvelle version
+c        convpn=SSUM(iim,qbyv(1,l),1)
+c        convmpn=ssum(iim,masse_adv_v(1,l),1)
+c        oldmasse=ssum(iim,masse(1,l),1)
+c        newmasse=oldmasse+convmpn
+c        newq=(q(1,l)*oldmasse+convpn)/newmasse
+c        newmasse=newmasse/apoln
+c        DO ij = 1,iip1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
+c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
+c        oldmasse=ssum(iim,masse(ip1jm-iim,l),1)
+c        newmasse=oldmasse+convmps
+c        newq=(q(ip1jmp1,l)*oldmasse+convps)/newmasse
+c        newmasse=newmasse/apols
+c        DO ij = ip1jm+1,ip1jmp1
+c           q(ij,l)=newq
+c           masse(ij,l)=newmasse*aire(ij)
+c        ENDDO
+c._. fin nouvelle version
+      ENDDO
+
+      RETURN
+      END
