Index: /LMDZ5/trunk/libf/dyn3dmem/abort_gcm.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/abort_gcm.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/abort_gcm.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: abort_gcm.F 1425 2010-09-02 13:45:23Z lguez $
+! $Id$
 !
 c
@@ -45,5 +45,4 @@
       if (ierr .eq. 0) then
         write(lunout,*) 'Everything is cool'
-        stop
       else
         write(lunout,*) 'Houston, we have a problem ', ierr
Index: /LMDZ5/trunk/libf/dyn3dmem/academic.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/academic.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/academic.h	(revision 1673)
@@ -1,5 +1,9 @@
 !
-! $Header$
+! $Id$
 !
-      real tetarappel(ip1jmp1,llm),taurappel
-      common/academic/tetarappel,taurappel
+      common/academic/tetarappel,knewt_t,kfrict,knewt_g,clat4
+      real :: tetarappel(ip1jmp1,llm)
+      real :: knewt_t(llm)
+      real :: kfrict(llm)
+      real :: knewt_g
+      real :: clat4(ip1jmp1)
Index: /LMDZ5/trunk/libf/dyn3dmem/addfi_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/addfi_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/addfi_loc.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
       SUBROUTINE addfi_loc(pdt, leapf, forward,
@@ -7,4 +7,5 @@
       USE parallel
       USE infotrac, ONLY : nqtot
+      USE control_mod, ONLY : planet_type
       IMPLICIT NONE
 c
@@ -156,4 +157,6 @@
 c$OMP END MASTER
  
+      if (planet_type=="earth") then
+      ! earth case, special treatment for first 2 tracers (water)
       DO iq = 1, 2
 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
@@ -177,4 +180,17 @@
 c$OMP END DO NOWAIT
       ENDDO
+      else
+      ! general case, treat all tracers equally)
+       DO iq = 1, nqtot
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+         DO k = 1,llm
+            DO j = ijb,ije
+               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
+c$OMP END DO NOWAIT
+       ENDDO
+      endif ! of if (planet_type=="earth")
 
 c$OMP MASTER
Index: /LMDZ5/trunk/libf/dyn3dmem/advtrac_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/advtrac_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/advtrac_loc.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: advtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id$
 !
 c
@@ -342,4 +342,6 @@
 c$OMP BARRIER
 
+      if (planet_type=="earth") then
+
       ijb=ij_begin
       ije=ij_end
@@ -355,4 +357,5 @@
        CALL qminimum_loc( q, 2, finmasse )
 
+      endif ! of if (planet_type=="earth")
 
        RETURN
Index: /LMDZ5/trunk/libf/dyn3dmem/bands.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/bands.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/bands.F90	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: bands.F90 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
   module Bands
@@ -105,6 +105,6 @@
    SUBROUTINE  Set_Bands 
      USE parallel
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth 
+#ifdef CPP_PHYS
+! Ehouarn: what follows is only related to // physics
      USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end
 #endif
@@ -118,6 +118,5 @@
       enddo
           
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth          
+#ifdef CPP_PHYS
       do i=0,MPI_Size-1
         jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
@@ -374,6 +373,6 @@
     subroutine AdjustBands_physic
       use times
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth 
+#ifdef CPP_PHYS
+! Ehouarn: what follows is only related to // physics
       USE mod_phys_lmdz_para, only : klon_mpi_para_nb
 #endif
@@ -401,6 +400,5 @@
       medium=medium/mpi_size      
       NbTot=0
-#ifdef CPP_EARTH
-! Ehouarn: what follows is only related to // physics; for now only for Earth 
+#ifdef CPP_PHYS
       do i=0,mpi_size-1
         Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))
Index: /LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_loc.F	(revision 1673)
@@ -421,5 +421,4 @@
           Q_cum(:,jjb:jje,:,l)=0.
           flux_uQ_cum(:,jjb:jje,l,:)=0.
-          flux_v_cum(:,jjb:jje,l)=0.
           if (pole_sud) jje=jj_end-1
           flux_v_cum(:,jjb:jje,l)=0.
Index: DZ5/trunk/libf/dyn3dmem/bilan_dyn_p.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/bilan_dyn_p.F	(revision 1672)
+++ 	(revision )
@@ -1,717 +1,0 @@
-!
-! $Id: bilan_dyn_p.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE bilan_dyn_p (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 * ...
-
-#ifdef CPP_IOIPSL
-      USE IOIPSL
-#endif
-      USE parallel
-      USE mod_hallo
-      use misc_mod
-      use write_field
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom2.h"
-#include "temps.h"
-#include "iniprint.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)
-
-
-cym      character*6 nom(nQ)
-cym      character*6 unites(nQ)
-      character*6,save :: nom(nQ)
-      character*6,save :: 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)
-
-cym      character*10 znom(ntr,nQ)
-cym      character*20 znoml(ntr,nQ)
-cym      character*10 zunites(ntr,nQ)
-      character*10,save :: znom(ntr,nQ)
-      character*20,save :: znoml(ntr,nQ)
-      character*10,save :: 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)
-      integer :: jjb,jje,jjn,ijb,ije
-      type(Request) :: Req
-
-! definition du domaine d'ecriture pour le rebuild
-
-      INTEGER,DIMENSION(1) :: ddid
-      INTEGER,DIMENSION(1) :: dsg
-      INTEGER,DIMENSION(1) :: dsl
-      INTEGER,DIMENSION(1) :: dpf
-      INTEGER,DIMENSION(1) :: dpl
-      INTEGER,DIMENSION(1) :: dhs
-      INTEGER,DIMENSION(1) :: dhe 
-      
-      INTEGER :: bilan_dyn_domain_id
-
-
-c=====================================================================
-c   Initialisation
-c=====================================================================
-      ndex3d=0
-      if (adjust) return
-      
-      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
-           WRITE(lunout,*)
-     .            'Pb : le pas de cumule doit etre multiple du pas'
-           WRITE(lunout,*)'dt_app=',dt_app
-           WRITE(lunout,*)'dt_cum=',dt_cum
-           stop
-        endif
-
-        if (i_sortie.eq.1) then
-	 file='dynzon'
-         if (mpi_rank==0) then
-	 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
-        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
-
-      jjb=jj_begin
-      jje=jj_end
-      jjn=jj_nb
-      IF (pole_sud) THEN
-        jjn=jj_nb-1
-        jje=jj_end-1
-      ENDIF
-
-      ddid=(/ 2 /)
-      dsg=(/ jjm /)
-      dsl=(/ jjn /)
-      dpf=(/ jjb /)
-      dpl=(/ jje /)
-      dhs=(/ 0 /)
-      dhe=(/ 0 /)
-
-      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 
-     .                 'box',bilan_dyn_domain_id)
-       
-      call histbeg(trim(infile),
-     .             1, rlong(jjb:jje), jjn, rlatg(jjb:jje),
-     .             1, 1, 1, jjn,
-     .             tau0, zjulian, dt_cum, thoriid, fileid,
-     .             bilan_dyn_domain_id)
-
-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
-c      print*,'1HISTDEF'
-      do iQ=1,nQ
-         do itr=1,ntr
-      IF (prt_level > 5)
-     . WRITE(lunout,*)'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,jjn,thoriid,llm,1,llm,zvertiid,
-     .        32,'ave(X)',dt_cum,dt_cum)
-         enddo
-c   Declarations pour les fonctions de courant
-c      print*,'2HISTDEF'
-          call histdef(fileid,'psi'//nom(iQ)
-     .      ,'stream fn. '//znoml(itot,iQ),
-     .      zunites(itot,iQ),1,jjn,thoriid,llm,1,llm,zvertiid,
-     .      32,'ave(X)',dt_cum,dt_cum)
-      enddo
-
-
-c   Declarations pour les champs de transport d'air
-c      print*,'3HISTDEF'
-      call histdef(fileid, 'masse', 'masse',
-     .             'kg', 1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', dt_cum, dt_cum)
-      call histdef(fileid, 'v', 'v',
-     .             'm/s', 1, jjn, thoriid, llm, 1, llm, zvertiid,
-     .             32, 'ave(X)', dt_cum, dt_cum)
-c   Declarations pour les fonctions de courant
-c      print*,'4HISTDEF'
-          call histdef(fileid,'psi','stream fn. MMC ','mega t/s',
-     .      1,jjn,thoriid,llm,1,llm,zvertiid,
-     .      32,'ave(X)',dt_cum,dt_cum)
-
-
-c   Declaration des champs 1D de transport en latitude
-c      print*,'5HISTDEF'
-      do iQ=1,nQ
-         do itr=2,ntr
-            call histdef(fileid,'a'//znom(itr,iQ),znoml(itr,iQ),
-     .        zunites(itr,iQ),1,jjn,thoriid,1,1,1,-99,
-     .        32,'ave(X)',dt_cum,dt_cum)
-         enddo
-      enddo
-
-
-c      print*,'8HISTDEF'
-               CALL histend(fileid)
-
-
-      endif
-
-
-c=====================================================================
-c   Calcul des champs dynamiques
-c   ----------------------------
-
-      jjb=jj_begin
-      jje=jj_end
-    
-c   énergie cinétique
-      ucont(:,jjb:jje,:)=0
-
-      call Register_Hallo(ucov,ip1jmp1,llm,1,1,1,1,Req)
-      call Register_Hallo(vcov,ip1jm,llm,1,1,1,1,Req)
-      call SendRequest(Req)
-      call WaitRequest(Req)
-
-      CALL covcont_p(llm,ucov,vcov,ucont,vcont)
-      CALL enercin_p(vcov,ucov,vcont,ucont,ecin)
-
-c   moment cinétique
-      do l=1,llm
-         ang(:,jjb:jje,l)=ucov(:,jjb:jje,l)+constang(:,jjb:jje)
-         unat(:,jjb:jje,l)=ucont(:,jjb:jje,l)*cu(:,jjb:jje)
-      enddo
-
-      Q(:,jjb:jje,:,itemp)=teta(:,jjb:jje,:)*pk(:,jjb:jje,:)/cpp
-      Q(:,jjb:jje,:,igeop)=phi(:,jjb:jje,:)
-      Q(:,jjb:jje,:,iecin)=ecin(:,jjb:jje,:)
-      Q(:,jjb:jje,:,iang)=ang(:,jjb:jje,:)
-      Q(:,jjb:jje,:,iu)=unat(:,jjb:jje,:)
-      Q(:,jjb:jje,:,iovap)=trac(:,jjb:jje,:,1)
-      Q(:,jjb:jje,:,iun)=1.
-
-
-c=====================================================================
-c   Cumul
-c=====================================================================
-c
-      if(icum.EQ.0) then
-         jjb=jj_begin
-         jje=jj_end
-
-         ps_cum(:,jjb:jje)=0.
-         masse_cum(:,jjb:jje,:)=0.
-         flux_u_cum(:,jjb:jje,:)=0.
-         Q_cum(:,jjb:jje,:,:)=0.
-         flux_uQ_cum(:,jjb:jje,:,:)=0.
-         flux_v_cum(:,jjb:jje,:)=0.
-         if (pole_sud) jje=jj_end-1
-         flux_v_cum(:,jjb:jje,:)=0.
-         flux_vQ_cum(:,jjb:jje,:,:)=0.
-      endif
-
-      IF (prt_level > 5)
-     . WRITE(lunout,*)'dans bilan_dyn ',icum,'->',icum+1
-      icum=icum+1
-
-c   accumulation des flux de masse horizontaux
-      jjb=jj_begin
-      jje=jj_end
-
-      ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)+ps(:,jjb:jje)
-      masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)+masse(:,jjb:jje,:)
-      flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)
-     .                       +flux_u(:,jjb:jje,:)
-      if (pole_sud) jje=jj_end-1
-      flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)
-     .                         +flux_v(:,jjb:jje,:)
-
-      jjb=jj_begin
-      jje=jj_end
-
-      do iQ=1,nQ
-        Q_cum(:,jjb:jje,:,iQ)=Q_cum(:,jjb:jje,:,iQ)
-     .                       +Q(:,jjb:jje,:,iQ)*masse(:,jjb:jje,:)
-      enddo
-
-c=====================================================================
-c  FLUX ET TENDANCES
-c=====================================================================
-
-c   Flux longitudinal
-c   -----------------
-      do iQ=1,nQ
-         do l=1,llm
-            do j=jjb,jje
-               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
-        call Register_Hallo(Q(1,1,1,iQ),ip1jmp1,llm,0,1,1,0,Req)
-      enddo
-      call SendRequest(Req)
-      call WaitRequest(Req)
-      
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-      
-      do iQ=1,nQ
-         do l=1,llm
-            do j=jjb,jje
-               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 Register_Hallo(flux_uQ_cum,ip1jmp1,llm,2,2,2,2,Req)
-      call Register_Hallo(flux_vQ_cum,ip1jm,llm,2,2,2,2,Req)
-      call SendRequest(Req)
-      call WaitRequest(Req)
-
-      call  convflu_p(flux_uQ_cum,flux_vQ_cum,llm*nQ,dQ)
-
-c   calcul de la vitesse verticale
-      call Register_Hallo(flux_u_cum,ip1jmp1,llm,2,2,2,2,Req)
-      call Register_Hallo(flux_v_cum,ip1jm,llm,2,2,2,2,Req)
-      call SendRequest(Req)
-      call WaitRequest(Req)
-
-      call convmas_p(flux_u_cum,flux_v_cum,convm)
-      CALL vitvert_p(convm,w)
-
-      jjb=jj_begin
-      jje=jj_end
-
-      do iQ=1,nQ
-         do l=1,llm-1
-            do j=jjb,jje
-               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
-      IF (prt_level > 5)
-     . WRITE(lunout,*)'Apres les calculs fait a chaque pas'
-c=====================================================================
-c   PAS DE TEMPS D'ECRITURE
-c=====================================================================
-      if (icum.eq.ncum) then
-c=====================================================================
-
-      IF (prt_level > 5)
-     . WRITE(lunout,*)'Pas d ecriture'
-
-c   Normalisation
-      do iQ=1,nQ
-         Q_cum(:,jjb:jje,:,iQ)=Q_cum(:,jjb:jje,:,iQ)
-     .	                      /masse_cum(:,jjb:jje,:)
-      enddo
-      zz=1./REAL(ncum)
-
-      jjb=jj_begin
-      jje=jj_end
-
-      ps_cum(:,jjb:jje)=ps_cum(:,jjb:jje)*zz
-      masse_cum(:,jjb:jje,:)=masse_cum(:,jjb:jje,:)*zz
-      flux_u_cum(:,jjb:jje,:)=flux_u_cum(:,jjb:jje,:)*zz
-      flux_uQ_cum(:,jjb:jje,:,:)=flux_uQ_cum(:,jjb:jje,:,:)*zz
-      dQ(:,jjb:jje,:,:)=dQ(:,jjb:jje,:,:)*zz
-      
-      IF (pole_sud) jje=jj_end-1
-      flux_v_cum(:,jjb:jje,:)=flux_v_cum(:,jjb:jje,:)*zz
-      flux_vQ_cum(:,jjb:jje,:,:)=flux_vQ_cum(:,jjb:jje,:,:)*zz
-
-      jjb=jj_begin
-      jje=jj_end
-
-
-c   A retravailler eventuellement
-c   division de dQ par la masse pour revenir aux bonnes grandeurs
-      do iQ=1,nQ
-         dQ(:,jjb:jje,:,iQ)=dQ(:,jjb:jje,:,iQ)/masse_cum(:,jjb:jje,:)
-      enddo
- 
-c=====================================================================
-c   Transport méridien
-c=====================================================================
-
-c   cumul zonal des masses des mailles
-c   ----------------------------------
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-
-      zv(jjb:jje,:)=0.
-      zmasse(jjb:jje,:)=0.
-
-      call Register_Hallo(masse_cum,ip1jmp1,llm,1,1,1,1,Req)
-      do iQ=1,nQ
-        call Register_Hallo(Q_cum(1,1,1,iQ),ip1jmp1,llm,0,1,1,0,Req)
-      enddo
-
-      call SendRequest(Req)
-      call WaitRequest(Req)
-
-      call massbar_p(masse_cum,massebx,masseby)
-      
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-      
-      do l=1,llm
-         do j=jjb,jje
-            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   ----------------------------------------
-
-      jjb=jj_begin
-      jje=jj_end
-      if (pole_sud) jje=jj_end-1
-      
-      zvQ=0.
-      psiQ=0.
-      do iQ=1,nQ
-         zvQtmp=0.
-         do l=1,llm
-            do j=jjb,jje
-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=jjb,jje
-               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(jjb:jje,:)=0.
-      do l=llm,1,-1
-         do j=jjb,jje
-            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
-      jjb=jj_begin
-      jje=jj_end
-      jjn=jj_nb
-      if (pole_sud) jje=jj_end-1
-      if (pole_sud) jjn=jj_nb-1
-      
-      do iQ=1,nQ
-         do itr=1,ntr
-            call histwrite(fileid,znom(itr,iQ),itau,
-     s                     zvQ(jjb:jje,:,itr,iQ)
-     s                     ,jjn*llm,ndex3d)
-         enddo
-         call histwrite(fileid,'psi'//nom(iQ),
-     s                  itau,psiQ(jjb:jje,1:llm,iQ)
-     s                  ,jjn*llm,ndex3d)
-      enddo
-
-      call histwrite(fileid,'masse',itau,zmasse(jjb:jje,1:llm)
-     s   ,jjn*llm,ndex3d)
-      call histwrite(fileid,'v',itau,zv(jjb:jje,1:llm)
-     s   ,jjn*llm,ndex3d)
-      psi(jjb:jje,:)=psi(jjb:jje,:)*1.e-9
-      call histwrite(fileid,'psi',itau,psi(jjb:jje,1:llm),
-     s               jjn*llm,ndex3d)
-
-      endif
-
-
-c   -----------------
-c   Moyenne verticale
-c   -----------------
-
-      zamasse(jjb:jje)=0.
-      do l=1,llm
-         zamasse(jjb:jje)=zamasse(jjb:jje)+zmasse(jjb:jje,l)
-      enddo
-     
-      zavQ(jjb:jje,:,:)=0.
-      do iQ=1,nQ
-         do itr=2,ntr
-            do l=1,llm
-               zavQ(jjb:jje,itr,iQ)=zavQ(jjb:jje,itr,iQ)
-     s                             +zvQ(jjb:jje,l,itr,iQ)
-     s                             *zmasse(jjb:jje,l)
-            enddo
-            zavQ(jjb:jje,itr,iQ)=zavQ(jjb:jje,itr,iQ)/zamasse(jjb:jje)
-            call histwrite(fileid,'a'//znom(itr,iQ),itau,
-     s                     zavQ(jjb:jje,itr,iQ),jjn*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: /LMDZ5/trunk/libf/dyn3dmem/caladvtrac_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/caladvtrac_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/caladvtrac_loc.F	(revision 1673)
@@ -8,6 +8,6 @@
      *                   flxw, pk, iapptrac)
       USE parallel 
-      USE infotrac
-      USE control_mod
+      USE infotrac, ONLY : nqtot
+      USE control_mod, ONLY : iapp_tracvl,planet_type
       USE caladvtrac_mod
       USE mod_hallo
@@ -38,5 +38,5 @@
       REAL :: masse(ijb_u:ije_u,llm)
       REAL :: p( ijb_u:ije_u,llmp1)
-      REAL :: q( ijb_u:ije_u,llm,nqtot),dq( ijb_u:ije_u,llm,2 )
+      REAL :: q( ijb_u:ije_u,llm,nqtot),dq( ijb_u:ije_u,llm, nqtot )
       REAL :: teta( ijb_u:ije_u,llm),pk( ijb_u:ije_u,llm)
       REAL :: flxw(ijb_u:ije_u,llm)
Index: /LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F	(revision 1673)
@@ -27,6 +27,6 @@
      $                  pdqfi,
      $                  pdpsfi)
-#ifdef CPP_EARTH
-! Ehouarn: For now, calfis_p needs Earth physics
+#ifdef CPP_PHYS
+! If using physics
 c
 c    Auteur :  P. Le Van, F. Hourdin 
@@ -36,8 +36,9 @@
       USE parallel, ONLY : omp_chunk, using_mpi,jjb_u,jje_u,jjb_v,jje_v
       USE mod_interface_dyn_phys
+      USE IOPHY
+#endif
       USE Write_Field
       Use Write_field_p
       USE Times
-      USE IOPHY
       USE infotrac
       USE control_mod
@@ -145,4 +146,6 @@
 
 
+#ifdef CPP_PHYS
+! Ehouarn: for now calfis_p needs some informations from physics to compile
 c    Local variables :
 c    -----------------
@@ -220,5 +223,5 @@
       PARAMETER(ntetaSTD=3)
       REAL rtetaSTD(ntetaSTD)
-      DATA rtetaSTD/350., 380., 405./
+      DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
       REAL PVteta(klon,ntetaSTD)
       
@@ -243,5 +246,7 @@
       REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:)
       integer :: k,kstart,kend
-      INTEGER :: offset  
+      INTEGER :: offset
+
+      LOGICAL tracerdyn  
 c
 c-----------------------------------------------------------------------
@@ -512,6 +517,7 @@
 
 
-      IF (is_sequential) THEN
-c
+      IF (is_sequential.and.(planet_type=="earth")) THEN
+#ifdef CPP_PHYS
+! PVtheta calls tetalevel, which is in the physics
 cIM calcul PV a teta=350, 380, 405K
         CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
@@ -519,4 +525,5 @@
      $           ntetaSTD,rtetaSTD,PVteta)
 c
+#endif
       ENDIF
 
@@ -662,7 +669,4 @@
 c$OMP BARRIER
       
-      if (planet_type=="earth") then
-#ifdef CPP_EARTH
-
 
 !$OMP MASTER 
@@ -675,4 +679,5 @@
       zdqfic_omp(:,:,:)=0.
 
+#ifdef CPP_PHYS
       do isplit=1,nsplit_phys
 
@@ -681,4 +686,5 @@
          lafin_split=lafin.and.isplit==nsplit_phys
 
+      if (planet_type=="earth") then
 
       CALL physiq (klon,
@@ -711,4 +717,33 @@
      .             PVteta)
 
+      else if ( planet_type=="generic" ) then
+
+      CALL physiq (klon,     !! ngrid
+     .             llm,            !! nlayer
+     .             nqtot,          !! nq
+     .             tname,          !! tracer names from dynamical core (given in infotrac)
+     .             debut_split,    !! firstcall 
+     .             lafin_split,    !! lastcall
+     .             float(day_ini), !! pday <-- day_ini (dans temps.h)
+     .             jH_cur_split,   !! ptime "fraction of day"
+     .             zdt_split,      !! ptimestep
+     .             zplev_omp,  !! pplev
+     .             zplay_omp,  !! pplay
+     .             zphi_omp,   !! pphi
+     .             zufi_omp,   !! pu
+     .             zvfi_omp,   !! pv
+     .             ztfi_omp,   !! pt
+     .             zqfi_omp,   !! pq
+     .             flxwfi_omp, !! pw !! or 0. anyway this is for diagnostic. not used in physiq.
+     .             zdufi_omp,  !! pdu
+     .             zdvfi_omp,  !! pdv
+     .             zdtfi_omp,  !! pdt
+     .             zdqfi_omp,  !! pdq
+     .             zdpsrf_omp, !! pdpsrf
+     .             tracerdyn)      !! tracerdyn <-- utilite ???
+
+      endif ! of if (planet_type=="earth")
+
+
          zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
          zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
@@ -723,4 +758,8 @@
       enddo
 
+#endif
+! of #ifdef CPP_PHYS
+
+
       zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
       zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
@@ -728,6 +767,4 @@
       zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
 
-#endif
-      endif !of if (planet_type=="earth")
 c$OMP BARRIER
 
@@ -1179,11 +1216,10 @@
       firstcal = .FALSE.
 
-#else
-      write(*,*) "calfis_p: for now can only work with parallel physics"
-      write(lunout,*)
-   & "calfis_p: for now can only work with parallel physics"
-      stop
-#endif
-! of #ifdef CPP_EARTH
+#else 
+      write(lunout,*) 
+     & "calfis_p: for now can only work with parallel physics" 
+      stop 
+#endif 
+! of #ifdef CPP_PHYS
       RETURN
       END
Index: /LMDZ5/trunk/libf/dyn3dmem/call_calfis_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/call_calfis_mod.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/call_calfis_mod.F90	(revision 1673)
@@ -136,6 +136,12 @@
   !$OMP END MASTER
    
-    jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec) 
-    jH_cur = jH_ref + (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+           jD_cur = jD_ref + day_ini - day_ref                           &
+     &        + itau/day_step
+           jH_cur = jH_ref + start_time +                                &
+     &              mod(itau,day_step)/float(day_step) 
+    if (jH_cur > 1.0 ) then
+      jD_cur = jD_cur +1.
+      jH_cur = jH_cur -1.
+    endif
 
 !   Inbterface avec les routines de phylmd (phymars ... )
Index: /LMDZ5/trunk/libf/dyn3dmem/call_dissip_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/call_dissip_mod.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/call_dissip_mod.F90	(revision 1673)
@@ -240,4 +240,8 @@
     !$OMP END DO NOWAIT
 
+         if (1 == 0) then
+!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
+!!!                     2) should probably not be here anyway
+!!! but are kept for those who would want to revert to previous behaviour
     !$OMP MASTER               
       DO ij =  1,iim
@@ -251,5 +255,6 @@
     !$OMP END MASTER
     
-    ENDIF
+    ENDIF ! of if (1 == 0)
+    endif ! of of (pole_nord)
         
     IF (pole_sud) THEN
@@ -269,4 +274,8 @@
     !$OMP END DO NOWAIT
 
+    if (1 == 0) then
+!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
+!!!                     2) should probably not be here anyway
+!!! but are kept for those who would want to revert to previous behaviour
     !$OMP MASTER               
       DO ij =  1,iim
@@ -279,5 +288,6 @@
       ENDDO
     !$OMP END MASTER
-    ENDIF
+    ENDIF ! of if (1 == 0)
+    endif ! of if (pole_sud)
 
 
Index: /LMDZ5/trunk/libf/dyn3dmem/ce0l.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/ce0l.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/ce0l.F90	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: ce0l.F90 1425 2010-09-02 13:45:23Z lguez $
+! $Id$
 !
 !-------------------------------------------------------------------------------
@@ -19,7 +19,8 @@
   USE dimphy
   USE comgeomphy
-  USE mod_phys_lmdz_para
+  USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
   USE mod_const_mpi
   USE infotrac
+  USE parallel, ONLY: finalize_parallel
 
 #ifdef CPP_IOIPSL
@@ -30,4 +31,5 @@
   IMPLICIT NONE
 #ifndef CPP_EARTH
+#include "iniprint.h"
   WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
 #else
@@ -41,12 +43,20 @@
 #include "temps.h"
 #include "logic.h"
+#ifdef CPP_MPI
+      include 'mpif.h'
+#endif
+
   INTEGER, PARAMETER            :: longcles=20
+  INTEGER                       :: ierr
   REAL,    DIMENSION(longcles)  :: clesphy0
   REAL,    DIMENSION(iip1,jjp1) :: masque
   CHARACTER(LEN=15)             :: calnd
+  REAL,    DIMENSION(iip1,jjp1) :: phis ! geopotentiel au sol
 !-------------------------------------------------------------------------------
   CALL conf_gcm( 99, .TRUE. , clesphy0 )
 
+#ifdef CPP_MPI
   CALL init_mpi
+#endif
 
   CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
@@ -55,5 +65,5 @@
        CALL abort_gcm('ce0l','In parallel mode,                         &
  &                 ce0l must be called only                             &
- &                 for 1 process and 1 task')
+ &                 for 1 process and 1 task',1)
   ENDIF
 
@@ -76,9 +86,12 @@
 #endif
 
-  IF (config_inca /= 'none') THEN
+  IF (type_trac == 'inca') THEN
 #ifdef INCA
-    CALL init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
-    CALL init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
-    WRITE(lunout,*)'nbtr =' , nbtr 
+      CALL init_const_lmdz( &
+         nbtr,anneeref,dayref,&
+         iphysiq,day_step,nday,& 
+         nbsrf, is_oce,is_sic,&
+         is_ter,is_lic)
+      
 #endif
   END IF
@@ -90,5 +103,5 @@
   WRITE(lunout,'(//)')
   WRITE(lunout,*) ' interbar = ',interbar
-  CALL etat0_netcdf(interbar,masque,ok_etat0)
+  CALL etat0_netcdf(interbar,masque,phis,ok_etat0)
 
   IF(ok_limit) THEN
@@ -101,4 +114,20 @@
   END IF
 
+  IF (grilles_gcm_netcdf) THEN
+     WRITE(lunout,'(//)')
+     WRITE(lunout,*) '  ***************************  '
+     WRITE(lunout,*) '  ***  grilles_gcm_netcdf ***  '
+     WRITE(lunout,*) '  ***************************  '
+     WRITE(lunout,'(//)')
+     CALL grilles_gcm_netcdf_sub(masque,phis)
+  END IF
+  
+#ifdef CPP_MPI
+!$OMP MASTER
+  CALL MPI_FINALIZE(ierr)
+  IF (ierr /= 0) CALL abort_gcm('ce0l','Error in MPI_FINALIZE',1)
+!$OMP END MASTER
+#endif
+
 #endif
 ! of #ifndef CPP_EARTH #else
Index: /LMDZ5/trunk/libf/dyn3dmem/comconst.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/comconst.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/comconst.h	(revision 1673)
@@ -1,23 +1,40 @@
 !
-! $Id: comconst.h 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
 !-----------------------------------------------------------------------
 ! INCLUDE comconst.h
 
-      COMMON/comconst/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,           &
-     & dtvr,daysec,                                                     &
+      COMMON/comconsti/im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl,          &
+     &                 iflag_top_bound
+      COMMON/comconstr/dtvr,daysec,                                     &
      & pi,dtphys,dtdiss,rad,r,cpp,kappa,cotot,unsim,g,omeg              &
      &                   ,dissip_factz,dissip_deltaz,dissip_zref        &
-     &                   ,iflag_top_bound,tau_top_bound
+     &                   ,tau_top_bound,                                &
+     & daylen,year_day,molmass, ihf
 
 
       INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
-      REAL dtvr,daysec
-      REAL pi,dtphys,dtdiss,rad,r,cpp,kappa
-      REAL cotot,unsim,g,omeg
+      REAL dtvr ! dynamical time step (in s)
+      REAL daysec !length (in s) of a standard day
+      REAL pi    ! something like 3.14159....
+      REAL dtphys ! (s) time step for the physics
+      REAL dtdiss ! (s) time step for the dissipation
+      REAL rad ! (m) radius of the planet
+      REAL r ! Reduced Gas constant r=R/mu 
+             ! with R=8.31.. J.K-1.mol-1, mu: mol mass of atmosphere (kg/mol) 
+      REAL cpp   ! Specific heat Cp (J.kg-1.K-1)
+      REAL kappa ! kappa=R/Cp 
+      REAL cotot
+      REAL unsim ! = 1./iim
+      REAL g ! (m/s2) gravity
+      REAL omeg ! (rad/s) rotation rate of the planet
       REAL dissip_factz,dissip_deltaz,dissip_zref
       INTEGER iflag_top_bound
       REAL tau_top_bound
+      REAL daylen ! length of solar day, in 'standard' day length
+      REAL year_day ! Number of standard days in a year
+      REAL molmass ! (g/mol) molar mass of the atmosphere
 
+      REAL ihf ! (W/m2) Intrinsic heat flux (for giant planets)
 
 !-----------------------------------------------------------------------
Index: /LMDZ5/trunk/libf/dyn3dmem/comdissipn.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/comdissipn.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/comdissipn.h	(revision 1673)
@@ -1,16 +1,20 @@
 !
-! $Header$
+! $Id$
 !
-c-----------------------------------------------------------------------
-c INCLUDE comdissipn.h
+!  Attention : ce fichier include est compatible format fixe/format libre
+!                 veillez à n'utiliser que des ! pour les commentaires
+!                 et à bien positionner les & des lignes de continuation 
+!                 (les placer en colonne 6 et en colonne 73)
+!-----------------------------------------------------------------------
+! INCLUDE comdissipn.h
 
       REAL  tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
-c
-      COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm)   ,
-     1                        cdivu,      crot,         cdivh
+!
+      COMMON/comdissipn/ tetaudiv(llm),tetaurot(llm),tetah(llm)   ,     &
+     &                        cdivu,      crot,         cdivh
 
-c
-c    Les parametres de ce common proviennent des calculs effectues dans 
-c             Inidissip  .
-c
-c-----------------------------------------------------------------------
+!
+!    Les parametres de ce common proviennent des calculs effectues dans 
+!             Inidissip  .
+!
+!-----------------------------------------------------------------------
Index: /LMDZ5/trunk/libf/dyn3dmem/comvert.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/comvert.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/comvert.h	(revision 1673)
@@ -1,14 +1,27 @@
 !
-! $Header$
+! $Id$
 !
 !-----------------------------------------------------------------------
 !   INCLUDE 'comvert.h'
 
-      COMMON/comvert/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),       &
-     &               pa,preff,nivsigs(llm),nivsig(llm+1)
+      COMMON/comvertr/ap(llm+1),bp(llm+1),presnivs(llm),dpres(llm),     &
+     &               pa,preff,nivsigs(llm),nivsig(llm+1),               &
+     &               aps(llm),bps(llm),scaleheight,pseudoalt(llm)
 
-      common/comverti/disvert_type
+      common/comverti/disvert_type, pressure_exner
 
-      REAL ap,bp,presnivs,dpres,pa,preff,nivsigs,nivsig
+      real ap     ! hybrid pressure contribution at interlayers
+      real bp     ! hybrid sigma contribution at interlayer
+      real presnivs ! (reference) pressure at mid-layers
+      real dpres
+      real pa     ! reference pressure (Pa) at which hybrid coordinates
+                  ! become purely pressure
+      real preff  ! reference surface pressure (Pa)
+      real nivsigs
+      real nivsig
+      real aps    ! hybrid pressure contribution at mid-layers
+      real bps    ! hybrid sigma contribution at mid-layers
+      real scaleheight ! atmospheric (reference) scale height (km)
+      real pseudoalt ! for planets
 
       integer disvert_type ! type of vertical discretization:
@@ -17,3 +30,8 @@
                            ! 2: Planets (default for planet_type!=earth),
                            !     using 'z2sig.def' (or 'esasig.def) file
-!-----------------------------------------------------------------------
+
+      logical pressure_exner
+!     compute pressure inside layers using Exner function, else use mean
+!     of pressure values at interfaces
+
+ !-----------------------------------------------------------------------
Index: /LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: conf_gcm.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id$
 !
 c
@@ -18,4 +18,5 @@
       use parallel, ONLY : omp_chunk
       USE control_mod
+      USE infotrac, ONLY : type_trac
       IMPLICIT NONE
 c-----------------------------------------------------------------------
@@ -103,5 +104,7 @@
       CALL getin('lunout', lunout)
       IF (lunout /= 5 .and. lunout /= 6) THEN
-        OPEN(lunout,FILE='lmdz.out')
+        OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write', 
+     &          STATUS='unknown',FORM='formatted')
+
       ENDIF
 
@@ -166,4 +169,12 @@
       CALL getin('nday',nday)
 
+!Config  Key  = starttime
+!Config  Desc = Heure de depart de la simulation
+!Config  Def  = 0
+!Config  Help = Heure de depart de la simulation
+!Config         en jour
+      starttime = 0
+      CALL getin('starttime',starttime)
+
 !Config  Key  = day_step
 !Config  Desc = nombre de pas par jour
@@ -226,11 +237,12 @@
        CALL getin('output_grads_dyn',output_grads_dyn)
 
-!Config  Key  = idissip
+!Config  Key  = dissip_period
 !Config  Desc = periode de la dissipation 
-!Config  Def  = 10
+!Config  Def  = 0
 !Config  Help = periode de la dissipation 
-!Config         (en pas) ... a completer !
-       idissip = 10
-       CALL getin('idissip',idissip)
+!Config  dissip_period=0 => la valeur sera calcule dans inidissip       
+!Config  dissip_period>0 => on prend cette valeur
+       dissip_period = 0
+       CALL getin('dissip_period',dissip_period)
 
 ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
@@ -579,4 +591,23 @@
        offline = .FALSE.
        CALL getin('offline',offline)
+       IF (offline .AND. adjust) THEN
+          WRITE(lunout,*) 
+     &         'WARNING : option offline does not work with adjust=y :'
+          WRITE(lunout,*) 'the files defstoke.nc, fluxstoke.nc ', 
+     &         'and fluxstokev.nc will not be created'
+          WRITE(lunout,*) 
+     &         'only the file phystoke.nc will still be created ' 
+       END IF
+       
+!Config  Key  = type_trac
+!Config  Desc = Choix de couplage avec model de chimie INCA ou REPROBUS
+!Config  Def  = lmdz
+!Config  Help = 
+!Config         'lmdz' = pas de couplage, pur LMDZ
+!Config         'inca' = model de chime INCA 
+!Config         'repr' = model de chime REPROBUS
+      type_trac = 'lmdz'
+      CALL getin('type_trac',type_trac)
+
 
 !Config  Key  = config_inca
@@ -628,5 +659,5 @@
       write(lunout,*)' periodav = ', periodav 
       write(lunout,*)' output_grads_dyn = ', output_grads_dyn
-      write(lunout,*)' idissip = ', idissip
+      write(lunout,*)' dissip_period = ', dissip_period
       write(lunout,*)' lstardis = ', lstardis
       write(lunout,*)' nitergdiv = ', nitergdiv
@@ -651,4 +682,5 @@
       write(lunout,*)' tauyy = ', tauyy
       write(lunout,*)' offline = ', offline
+      write(lunout,*)' type_trac = ', type_trac
       write(lunout,*)' config_inca = ', config_inca
       write(lunout,*)' ok_dynzon = ', ok_dynzon 
@@ -769,4 +801,22 @@
        offline = .FALSE.
        CALL getin('offline',offline)
+       IF (offline .AND. adjust) THEN
+          WRITE(lunout,*) 
+     &         'WARNING : option offline does not work with adjust=y :'
+          WRITE(lunout,*) 'the files defstoke.nc, fluxstoke.nc ', 
+     &         'and fluxstokev.nc will not be created'
+          WRITE(lunout,*) 
+     &         'only the file phystoke.nc will still be created ' 
+       END IF
+
+!Config  Key  = type_trac
+!Config  Desc = Choix de couplage avec model de chimie INCA ou REPROBUS
+!Config  Def  = lmdz
+!Config  Help = 
+!Config         'lmdz' = pas de couplage, pur LMDZ
+!Config         'inca' = model de chime INCA 
+!Config         'repr' = model de chime REPROBUS
+      type_trac = 'lmdz'
+      CALL getin('type_trac',type_trac)
 
 !Config  Key  = config_inca
@@ -875,4 +925,10 @@
       CALL getin('ok_etat0',ok_etat0)
 
+!Config  Key  = grilles_gcm_netcdf
+!Config  Desc = creation de fichier grilles_gcm.nc dans create_etat0_limit
+!Config  Def  = n
+      grilles_gcm_netcdf = .FALSE.
+      CALL getin('grilles_gcm_netcdf',grilles_gcm_netcdf)
+
       write(lunout,*)' #########################################'
       write(lunout,*)' Configuration des parametres de cel0'
@@ -889,5 +945,5 @@
       write(lunout,*)' periodav = ', periodav 
       write(lunout,*)' output_grads_dyn = ', output_grads_dyn
-      write(lunout,*)' idissip = ', idissip
+      write(lunout,*)' dissip_period = ', dissip_period
       write(lunout,*)' lstardis = ', lstardis
       write(lunout,*)' nitergdiv = ', nitergdiv
@@ -912,4 +968,5 @@
       write(lunout,*)' tauy = ', tauy
       write(lunout,*)' offline = ', offline
+      write(lunout,*)' type_trac = ', type_trac
       write(lunout,*)' config_inca = ', config_inca
       write(lunout,*)' ok_dynzon = ', ok_dynzon 
@@ -923,4 +980,5 @@
       write(lunout,*)' ok_limit = ', ok_limit
       write(lunout,*)' ok_etat0 = ', ok_etat0
+      write(lunout,*)' grilles_gcm_netcdf = ', grilles_gcm_netcdf
 c
       RETURN
Index: /LMDZ5/trunk/libf/dyn3dmem/conf_planete.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/conf_planete.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/conf_planete.F90	(revision 1673)
@@ -0,0 +1,70 @@
+!
+! $Id$
+!
+SUBROUTINE conf_planete
+!
+#ifdef CPP_IOIPSL
+USE IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+USE ioipsl_getincom
+#endif
+IMPLICIT NONE
+!
+!
+!   Declarations :
+!   --------------
+#include "dimensions.h"
+#include "comconst.h"
+#include "comvert.h"
+!
+!   local:
+!   ------
+
+! ---------------------------------------------
+! Initialisations de constantes de la dynamique
+! ---------------------------------------------
+! Pi
+pi=2.*asin(1.)
+
+!Reference surface pressure (Pa)
+preff=101325.
+CALL getin('preff', preff)
+! Reference pressure at which hybrid coord. become purely pressure
+! pa=50000.
+pa=preff/2.
+CALL getin('pa', pa)
+! Gravity
+g=9.80665
+CALL getin('g',g)
+! Molar mass of the atmosphere
+molmass = 28.9644
+CALL getin('molmass',molmass)
+! kappa=R/Cp et Cp      
+kappa = 2./7.
+CALL getin('kappa',kappa)
+cpp=8.3145/molmass/kappa*1000.
+CALL getin('cpp',cpp)
+! Radius of the planet
+rad = 6371229. 
+CALL getin('radius',rad)
+! Length of a standard day (s)
+daysec=86400.
+CALL getin('daysec',daysec)
+! Rotation rate of the planet:
+! Length of a solar day, in standard days
+daylen = 1.
+CALL getin('daylen',daylen)
+! Number of days (standard) per year:
+year_day = 365.25
+CALL getin('year_day',year_day)
+! Omega
+! omeg=2.*pi/86400.
+omeg=2.*pi/daysec*(1./daylen+1./year_day)
+CALL getin('omeg',omeg)
+
+! Intrinsic heat flux (default: none) (only used if planet_type="giant")
+ihf = 0.
+call getin('ihf',ihf)
+
+END SUBROUTINE conf_planete
Index: /LMDZ5/trunk/libf/dyn3dmem/control_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/control_mod.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/control_mod.F90	(revision 1673)
@@ -10,7 +10,7 @@
   IMPLICIT NONE
 
-  REAL    :: periodav
+  REAL    :: periodav, starttime
   INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
-  INTEGER :: iconser,iecri,idissip,iphysiq,iecrimoy
+  INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy
   INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
   LOGICAL :: offline
Index: /LMDZ5/trunk/libf/dyn3dmem/defrun.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/defrun.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/defrun.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: defrun.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id$
 !
 c
@@ -132,7 +132,7 @@
 
       READ (tapedef,9001) ch1,ch4
-      READ (tapedef,*)    idissip
-      WRITE(tapeout,9001) ch1,'idissip'
-      WRITE(tapeout,*)    idissip
+      READ (tapedef,*)    dissip_period
+      WRITE(tapeout,9001) ch1,'dissip_period'
+      WRITE(tapeout,*)    dissip_period
 
 ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
Index: DZ5/trunk/libf/dyn3dmem/disvert.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/disvert.F	(revision 1672)
+++ 	(revision )
@@ -1,194 +1,0 @@
-!
-! $Id: disvert.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-
-c    Auteur :  P. Le Van .
-c
-      IMPLICIT NONE
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "iniprint.h"
-#include "logic.h"
-c
-c=======================================================================
-c
-c
-c    s = sigma ** kappa   :  coordonnee  verticale
-c    dsig(l)            : epaisseur de la couche l ds la coord.  s
-c    sig(l)             : sigma a l'interface des couches l et l-1
-c    ds(l)              : distance entre les couches l et l-1 en coord.s
-c
-c=======================================================================
-c
-      REAL pa,preff
-      REAL ap(llmp1),bp(llmp1),dpres(llm),nivsigs(llm),nivsig(llmp1)
-      REAL presnivs(llm)
-c
-c   declarations:
-c   -------------
-c
-      REAL sig(llm+1),dsig(llm)
-       real zzz(1:llm+1)
-       real dzz(1:llm)
-      real zk,zkm1,dzk1,dzk2,k0,k1
-c
-      INTEGER l
-      REAL snorm,dsigmin
-      REAL alpha,beta,gama,delta,deltaz,h
-      INTEGER np,ierr
-      REAL pi,x
-
-      REAL SSUM
-c
-c-----------------------------------------------------------------------
-c
-      pi=2.*ASIN(1.)
-
-      OPEN(99,file='sigma.def',status='old',form='formatted',
-     s   iostat=ierr)
-
-c-----------------------------------------------------------------------
-c   cas 1 on lit les options dans sigma.def:
-c   ----------------------------------------
-
-      IF (ierr.eq.0) THEN
-
-      READ(99,*) h           ! hauteur d'echelle 8.
-      READ(99,*) deltaz      ! epaiseur de la premiere couche 0.04
-      READ(99,*) beta        ! facteur d'acroissement en haut 1.3
-      READ(99,*) k0          ! nombre de couches dans la transition surf
-      READ(99,*) k1          ! nombre de couches dans la transition haute
-      CLOSE(99)
-      alpha=deltaz/(llm*h)
-      write(lunout,*)'h,alpha,k0,k1,beta'
-
-c     read(*,*) h,deltaz,beta,k0,k1 ! 8 0.04 4 20 1.2
-
-      alpha=deltaz/tanh(1./k0)*2.
-      zkm1=0.
-      sig(1)=1.
-      do l=1,llm
-        sig(l+1)=(cosh(l/k0))**(-alpha*k0/h)
-     + *exp(-alpha/h*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta))
-        zk=-h*log(sig(l+1))
-
-        dzk1=alpha*tanh(l/k0)
-        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
-        write(lunout,*)l,sig(l+1),zk,zk-zkm1,dzk1,dzk2
-        zkm1=zk
-      enddo
-
-      sig(llm+1)=0.
-
-c
-       DO 2  l = 1, llm
-       dsig(l) = sig(l)-sig(l+1)
-   2   CONTINUE
-c
-
-      ELSE
-c-----------------------------------------------------------------------
-c   cas 2 ancienne discretisation (LMD5...):
-c   ----------------------------------------
-
-      WRITE(LUNOUT,*)'WARNING!!! Ancienne discretisation verticale'
-
-      if (ok_strato) then
-         if (llm==39) then
-            dsigmin=0.3
-         else if (llm==50) then
-            dsigmin=1.
-         else
-            WRITE(LUNOUT,*) 'ATTENTION discretisation z a ajuster'
-            dsigmin=1.
-         endif
-         WRITE(LUNOUT,*) 'Discretisation verticale DSIGMIN=',dsigmin
-      endif
-
-      h=7.
-      snorm  = 0.
-      DO l = 1, llm
-         x = 2.*asin(1.) * (REAL(l)-0.5) / REAL(llm+1)
-
-         IF (ok_strato) THEN
-           dsig(l) =(dsigmin + 7.0 * SIN(x)**2)
-     &            *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2        
-         ELSE
-           dsig(l) = 1.0 + 7.0 * SIN(x)**2
-         ENDIF
-
-         snorm = snorm + dsig(l)
-      ENDDO
-      snorm = 1./snorm
-      DO l = 1, llm
-         dsig(l) = dsig(l)*snorm
-      ENDDO
-      sig(llm+1) = 0.
-      DO l = llm, 1, -1
-         sig(l) = sig(l+1) + dsig(l)
-      ENDDO
-
-      ENDIF
-
-
-      DO l=1,llm
-        nivsigs(l) = REAL(l)
-      ENDDO
-
-      DO l=1,llmp1
-        nivsig(l)= REAL(l)
-      ENDDO
-
-c
-c    ....  Calculs  de ap(l) et de bp(l)  ....
-c    .........................................
-c
-c
-c   .....  pa et preff sont lus  sur les fichiers start par lectba  .....
-c
-
-      bp(llmp1) =   0.
-
-      DO l = 1, llm
-cc
-ccc    ap(l) = 0.
-ccc    bp(l) = sig(l)
-
-      bp(l) = EXP( 1. -1./( sig(l)*sig(l)) )
-      ap(l) = pa * ( sig(l) - bp(l) )
-c
-      ENDDO
-
-      bp(1)=1.
-      ap(1)=0.
-
-      ap(llmp1) = pa * ( sig(llmp1) - bp(llmp1) )
-
-      write(lunout,*)' BP '
-      write(lunout,*)  bp
-      write(lunout,*)' AP '
-      write(lunout,*)  ap
-
-      write(lunout,*)
-     .'Niveaux de pressions approximatifs aux centres des'
-      write(lunout,*)'couches calcules pour une pression de surface =',
-     .                 preff
-      write(lunout,*)
-     .     'et altitudes equivalentes pour une hauteur d echelle de'
-      write(lunout,*)'8km'
-      DO l = 1, llm
-       dpres(l) = bp(l) - bp(l+1)
-       presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
-       write(lunout,*)'PRESNIVS(',l,')=',presnivs(l),'    Z ~ ',
-     .        log(preff/presnivs(l))*8.
-     .  ,'   DZ ~ ',8.*log((ap(l)+bp(l)*preff)/
-     .       max(ap(l+1)+bp(l+1)*preff,1.e-10))
-      ENDDO
-
-      write(lunout,*)' PRESNIVS '
-      write(lunout,*)presnivs
-
-      RETURN
-      END
Index: /LMDZ5/trunk/libf/dyn3dmem/disvert.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/disvert.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/disvert.F90	(revision 1673)
@@ -0,0 +1,180 @@
+! $Id: disvert.F90 1645 2012-07-30 16:01:50Z lguez $
+
+SUBROUTINE disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig,scaleheight)
+
+  ! Auteur : P. Le Van
+
+  use new_unit_m, only: new_unit
+  use ioipsl, only: getin
+  use assert_m, only: assert
+
+  IMPLICIT NONE
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "iniprint.h"
+  include "logic.h"
+
+  ! s = sigma ** kappa : coordonnee verticale
+  ! dsig(l) : epaisseur de la couche l ds la coord. s
+  ! sig(l) : sigma a l'interface des couches l et l-1
+  ! ds(l) : distance entre les couches l et l-1 en coord.s
+
+  real,intent(in) :: pa, preff
+  real,intent(out) :: ap(llmp1) ! in Pa
+  real, intent(out):: bp(llmp1)
+  real,intent(out) :: dpres(llm), nivsigs(llm), nivsig(llmp1)
+  real,intent(out) :: presnivs(llm)
+  real,intent(out) :: scaleheight
+
+  REAL sig(llm+1), dsig(llm)
+  real zk, zkm1, dzk1, dzk2, k0, k1
+
+  INTEGER l, unit
+  REAL dsigmin
+  REAL alpha, beta, deltaz
+  REAL x
+  character(len=*),parameter :: modname="disvert"
+
+  character(len=6):: vert_sampling
+  ! (allowed values are "param", "tropo", "strato" and "read")
+
+  !-----------------------------------------------------------------------
+
+  print *, "Call sequence information: disvert"
+
+  ! default scaleheight is 8km for earth
+  scaleheight=8.
+
+  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
+  call getin('vert_sampling', vert_sampling)
+  print *, 'vert_sampling = ' // vert_sampling
+
+  select case (vert_sampling)
+  case ("param")
+     ! On lit les options dans sigma.def:
+     OPEN(99, file='sigma.def', status='old', form='formatted')
+     READ(99, *) scaleheight ! hauteur d'echelle 8.
+     READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
+     READ(99, *) beta ! facteur d'acroissement en haut 1.3
+     READ(99, *) k0 ! nombre de couches dans la transition surf
+     READ(99, *) k1 ! nombre de couches dans la transition haute
+     CLOSE(99)
+     alpha=deltaz/(llm*scaleheight)
+     write(lunout, *)trim(modname),':scaleheight, alpha, k0, k1, beta', &
+                               scaleheight, alpha, k0, k1, beta
+
+     alpha=deltaz/tanh(1./k0)*2.
+     zkm1=0.
+     sig(1)=1.
+     do l=1, llm
+        sig(l+1)=(cosh(l/k0))**(-alpha*k0/scaleheight) &
+             *exp(-alpha/scaleheight*tanh((llm-k1)/k0) &
+                  *beta**(l-(llm-k1))/log(beta))
+        zk=-scaleheight*log(sig(l+1))
+
+        dzk1=alpha*tanh(l/k0)
+        dzk2=alpha*tanh((llm-k1)/k0)*beta**(l-(llm-k1))/log(beta)
+        write(lunout, *)l, sig(l+1), zk, zk-zkm1, dzk1, dzk2
+        zkm1=zk
+     enddo
+
+     sig(llm+1)=0.
+
+     bp(: llm) = EXP(1. - 1. / sig(: llm)**2)
+     bp(llmp1) = 0.
+
+     ap = pa * (sig - bp)
+  case("tropo")
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) = 1.0 + 7.0 * SIN(x)**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+
+     bp(1)=1.
+     bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2)
+     bp(llmp1) = 0.
+
+     ap(1)=0.
+     ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
+  case("strato")
+     if (llm==39) then
+        dsigmin=0.3
+     else if (llm==50) then
+        dsigmin=1.
+     else
+        write(lunout,*) trim(modname), ' ATTENTION discretisation z a ajuster'
+        dsigmin=1.
+     endif
+     WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
+
+     DO l = 1, llm
+        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
+        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
+             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
+     ENDDO
+     dsig = dsig / sum(dsig)
+     sig(llm+1) = 0.
+     DO l = llm, 1, -1
+        sig(l) = sig(l+1) + dsig(l)
+     ENDDO
+
+     bp(1)=1.
+     bp(2: llm) = EXP(1. - 1. / sig(2: llm)**2)
+     bp(llmp1) = 0.
+
+     ap(1)=0.
+     ap(2: llm + 1) = pa * (sig(2: llm + 1) - bp(2: llm + 1))
+  case("read")
+     ! Read "ap" and "bp". First line is skipped (title line). "ap"
+     ! should be in Pa. First couple of values should correspond to
+     ! the surface, that is : "bp" should be in descending order.
+     call new_unit(unit)
+     open(unit, file="hybrid.txt", status="old", action="read", &
+          position="rewind")
+     read(unit, fmt=*) ! skip title line
+     do l = 1, llm + 1
+        read(unit, fmt=*) ap(l), bp(l)
+     end do
+     close(unit)
+     call assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., &
+          bp(llm + 1) == 0., "disvert: bad ap or bp values")
+  case default
+     call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
+  END select
+
+  DO l=1, llm
+     nivsigs(l) = REAL(l)
+  ENDDO
+
+  DO l=1, llmp1
+     nivsig(l)= REAL(l)
+  ENDDO
+
+  write(lunout, *)  trim(modname),': BP '
+  write(lunout, *) bp
+  write(lunout, *)  trim(modname),': AP '
+  write(lunout, *) ap
+
+  write(lunout, *) 'Niveaux de pressions approximatifs aux centres des'
+  write(lunout, *)'couches calcules pour une pression de surface =', preff
+  write(lunout, *) 'et altitudes equivalentes pour une hauteur d echelle de '
+  write(lunout, *) scaleheight,' km'
+  DO l = 1, llm
+     dpres(l) = bp(l) - bp(l+1)
+     presnivs(l) = 0.5 *( ap(l)+bp(l)*preff + ap(l+1)+bp(l+1)*preff )
+     write(lunout, *)'PRESNIVS(', l, ')=', presnivs(l), ' Z ~ ', &
+          log(preff/presnivs(l))*scaleheight &
+          , ' DZ ~ ', scaleheight*log((ap(l)+bp(l)*preff)/ &
+          max(ap(l+1)+bp(l+1)*preff, 1.e-10))
+  ENDDO
+
+  write(lunout, *) trim(modname),': PRESNIVS '
+  write(lunout, *) presnivs
+
+END SUBROUTINE disvert
Index: /LMDZ5/trunk/libf/dyn3dmem/disvert_noterre.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/disvert_noterre.F	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/disvert_noterre.F	(revision 1673)
@@ -0,0 +1,330 @@
+! $Id$
+      SUBROUTINE disvert_noterre
+
+c    Auteur :  F. Forget Y. Wanherdrick, P. Levan
+c    Nouvelle version 100% Mars !!
+c    On l'utilise aussi pour Venus et Titan, legerment modifiee.
+
+#ifdef CPP_IOIPSL
+      use IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      use ioipsl_getincom
+#endif
+
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comconst.h"
+#include "logic.h"
+#include "iniprint.h"
+c
+c=======================================================================
+c    Discretisation verticale en coordonnée hybride (ou sigma)
+c
+c=======================================================================
+c
+c   declarations:
+c   -------------
+c
+c
+      INTEGER l,ll
+      REAL snorm
+      REAL alpha,beta,gama,delta,deltaz
+      real quoi,quand
+      REAL zsig(llm),sig(llm+1)
+      INTEGER np,ierr
+      integer :: ierr1,ierr2,ierr3,ierr4
+      REAL x
+
+      REAL SSUM
+      EXTERNAL SSUM
+      real newsig 
+      REAL dz0,dz1,nhaut,sig1,esig,csig,zz
+      real tt,rr,gg, prevz
+      real s(llm),dsig(llm) 
+
+      integer iz 
+      real z, ps,p
+      character(len=*),parameter :: modname="disvert_noterre"
+
+c
+c-----------------------------------------------------------------------
+c
+! Initializations:
+!      pi=2.*ASIN(1.) ! already done in iniconst
+      
+      hybrid=.true. ! default value for hybrid (ie: use hybrid coordinates)
+      CALL getin('hybrid',hybrid)
+      write(lunout,*) trim(modname),': hybrid=',hybrid
+
+! Ouverture possible de fichiers typiquement E.T.
+
+         open(99,file="esasig.def",status='old',form='formatted',
+     s   iostat=ierr2)
+         if(ierr2.ne.0) then
+              close(99)
+              open(99,file="z2sig.def",status='old',form='formatted',
+     s        iostat=ierr4)
+         endif
+
+c-----------------------------------------------------------------------
+c   cas 1 on lit les options dans esasig.def:
+c   ----------------------------------------
+
+      IF(ierr2.eq.0) then
+
+c        Lecture de esasig.def :
+c        Systeme peu souple, mais qui respecte en theorie
+c        La conservation de l'energie (conversion Energie potentielle
+c        <-> energie cinetique, d'apres la note de Frederic Hourdin...
+
+         write(lunout,*)'*****************************'
+         write(lunout,*)'WARNING reading esasig.def'
+         write(lunout,*)'*****************************'
+         READ(99,*) scaleheight
+         READ(99,*) dz0
+         READ(99,*) dz1
+         READ(99,*) nhaut
+         CLOSE(99)
+
+         dz0=dz0/scaleheight
+         dz1=dz1/scaleheight
+
+         sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut)
+
+         esig=1.
+
+         do l=1,20
+            esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.)
+         enddo
+         csig=(1./sig1-1.)/(exp(esig)-1.)
+
+         DO L = 2, llm
+            zz=csig*(exp(esig*(l-1.))-1.)
+            sig(l) =1./(1.+zz)
+     &      * tanh(.5*(llm+1-l)/nhaut)
+         ENDDO
+         sig(1)=1.
+         sig(llm+1)=0.
+         quoi      = 1. + 2.* kappa
+         s( llm )  = 1.
+         s(llm-1) = quoi
+         IF( llm.gt.2 )  THEN
+            DO  ll = 2, llm-1
+               l         = llm+1 - ll
+               quand     = sig(l+1)/ sig(l)
+               s(l-1)    = quoi * (1.-quand) * s(l)  + quand * s(l+1)
+            ENDDO
+         END IF
+c
+         snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2)
+         DO l = 1, llm
+            s(l)    = s(l)/ snorm
+         ENDDO
+
+c-----------------------------------------------------------------------
+c   cas 2 on lit les options dans z2sig.def:
+c   ----------------------------------------
+
+      ELSE IF(ierr4.eq.0) then
+         write(lunout,*)'****************************'
+         write(lunout,*)'Reading z2sig.def'
+         write(lunout,*)'****************************'
+
+         READ(99,*) scaleheight
+         do l=1,llm
+            read(99,*) zsig(l)
+         end do
+         CLOSE(99)
+
+         sig(1) =1
+         do l=2,llm
+           sig(l) = 0.5 * ( exp(-zsig(l)/scaleheight) + 
+     &                      exp(-zsig(l-1)/scaleheight) )
+         end do
+         sig(llm+1) =0
+
+c-----------------------------------------------------------------------
+      ELSE
+         write(lunout,*) 'didn t you forget something ??? '
+         write(lunout,*) 'We need file  z2sig.def ! (OR esasig.def)'
+         stop
+      ENDIF
+c-----------------------------------------------------------------------
+
+      DO l=1,llm
+        nivsigs(l) = REAL(l)
+      ENDDO
+
+      DO l=1,llmp1
+        nivsig(l)= REAL(l)
+      ENDDO
+
+ 
+c-----------------------------------------------------------------------
+c    ....  Calculs  de ap(l) et de bp(l)  ....
+c    .........................................
+c
+c   .....  pa et preff sont lus  sur les fichiers start par dynetat0 .....
+c-----------------------------------------------------------------------
+c
+
+      if (hybrid) then  ! use hybrid coordinates
+         write(lunout,*) "*********************************"
+         write(lunout,*) "Using hybrid vertical coordinates"
+         write(lunout,*) 
+c        Coordonnees hybrides avec mod
+         DO l = 1, llm
+
+         call sig_hybrid(sig(l),pa,preff,newsig)
+            bp(l) = EXP( 1. - 1./(newsig**2)  )
+            ap(l) = pa * (newsig - bp(l) )
+         enddo
+         bp(llmp1) = 0.
+         ap(llmp1) = 0.
+      else ! use sigma coordinates
+         write(lunout,*) "********************************"
+         write(lunout,*) "Using sigma vertical coordinates"
+         write(lunout,*) 
+c        Pour ne pas passer en coordonnees hybrides
+         DO l = 1, llm
+            ap(l) = 0.
+            bp(l) = sig(l)
+         ENDDO
+         ap(llmp1) = 0.
+      endif
+
+      bp(llmp1) =   0.
+
+      write(lunout,*) trim(modname),': BP '
+      write(lunout,*)  bp
+      write(lunout,*) trim(modname),': AP '
+      write(lunout,*)  ap
+
+c     Calcul au milieu des couches :
+c     WARNING : le choix de placer le milieu des couches au niveau de
+c     pression intermédiaire est arbitraire et pourrait etre modifié.
+c     Le calcul du niveau pour la derniere couche 
+c     (on met la meme distance (en log pression)  entre P(llm)
+c     et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est
+c     Specifique.  Ce choix est spécifié ici ET dans exner_milieu.F
+
+      DO l = 1, llm-1
+       aps(l) =  0.5 *( ap(l) +ap(l+1)) 
+       bps(l) =  0.5 *( bp(l) +bp(l+1)) 
+      ENDDO
+     
+      if (hybrid) then
+         aps(llm) = aps(llm-1)**2 / aps(llm-2) 
+         bps(llm) = 0.5*(bp(llm) + bp(llm+1))
+      else
+         bps(llm) = bps(llm-1)**2 / bps(llm-2) 
+         aps(llm) = 0.
+      end if
+
+      write(lunout,*) trim(modname),': BPs '
+      write(lunout,*)  bps
+      write(lunout,*) trim(modname),': APs'
+      write(lunout,*)  aps
+
+      DO l = 1, llm
+       presnivs(l) = aps(l)+bps(l)*preff
+       pseudoalt(l) = -scaleheight*log(presnivs(l)/preff)
+      ENDDO
+
+      write(lunout,*)trim(modname),' : PRESNIVS' 
+      write(lunout,*)presnivs 
+      write(lunout,*)'Pseudo altitude of Presnivs : (for a scale ',
+     &                'height of ',scaleheight,' km)' 
+      write(lunout,*)pseudoalt
+
+c     --------------------------------------------------
+c     This can be used to plot the vertical discretization
+c     (> xmgrace -nxy testhybrid.tab )
+c     --------------------------------------------------
+c     open (53,file='testhybrid.tab')
+c     scaleheight=15.5
+c     do iz=0,34
+c       z = -5 + min(iz,34-iz)
+c     approximation of scale height for Venus
+c       scaleheight = 15.5 - z/55.*10.
+c       ps = preff*exp(-z/scaleheight)
+c       zsig(1)= -scaleheight*log((aps(1) + bps(1)*ps)/preff)
+c       do l=2,llm
+c     approximation of scale height for Venus
+c          if (zsig(l-1).le.55.) then
+c             scaleheight = 15.5 - zsig(l-1)/55.*10.
+c          else
+c             scaleheight = 5.5 - (zsig(l-1)-55.)/35.*2.
+c          endif
+c          zsig(l)= zsig(l-1)-scaleheight*
+c    .    log((aps(l) + bps(l)*ps)/(aps(l-1) + bps(l-1)*ps))
+c       end do
+c       write(53,'(I3,50F10.5)') iz, zsig
+c      end do
+c      close(53)
+c     --------------------------------------------------
+
+
+      RETURN
+      END
+
+c ************************************************************
+      subroutine sig_hybrid(sig,pa,preff,newsig)
+c     ----------------------------------------------
+c     Subroutine utilisee pour calculer des valeurs de sigma modifie
+c     pour conserver les coordonnees verticales decrites dans
+c     esasig.def/z2sig.def lors du passage en coordonnees hybrides
+c     F. Forget 2002
+c     Connaissant sig (niveaux "sigma" ou on veut mettre les couches)
+c     L'objectif est de calculer newsig telle que
+c       (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig
+c     Cela ne se résoud pas analytiquement: 
+c     => on résoud par iterration bourrine 
+c     ----------------------------------------------
+c     Information  : where exp(1-1./x**2) become << x
+c           x      exp(1-1./x**2) /x
+c           1           1
+c           0.68       0.5
+c           0.5        1.E-1
+c           0.391      1.E-2
+c           0.333      1.E-3
+c           0.295      1.E-4
+c           0.269      1.E-5
+c           0.248      1.E-6
+c        => on peut utiliser newsig = sig*preff/pa si sig*preff/pa < 0.25
+
+
+      implicit none
+      real x1, x2, sig,pa,preff, newsig, F
+      integer j
+
+      newsig = sig
+      x1=0
+      x2=1
+      if (sig.ge.1) then
+            newsig= sig
+      else if (sig*preff/pa.ge.0.25) then
+        DO J=1,9999  ! nombre d''iteration max
+          F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
+c         write(0,*) J, ' newsig =', newsig, ' F= ', F
+          if (F.gt.1) then
+              X2 = newsig
+              newsig=(X1+newsig)*0.5
+          else
+              X1 = newsig
+              newsig=(X2+newsig)*0.5
+          end if
+c         Test : on arete lorsque on approxime sig à moins de 0.01 m près 
+c         (en pseudo altitude) :
+          IF(abs(10.*log(F)).LT.1.E-5) goto 999
+        END DO
+       else   !    if (sig*preff/pa.le.0.25) then
+             newsig= sig*preff/pa
+       end if
+ 999   continue
+       Return
+      END
Index: DZ5/trunk/libf/dyn3dmem/dynetat0.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/dynetat0.F	(revision 1672)
+++ 	(revision )
@@ -1,386 +1,0 @@
-!
-! $Id $
-!
-      SUBROUTINE dynetat0(fichnom,vcov,ucov,
-     .                    teta,q,masse,ps,phis,time)
-
-      USE infotrac
-      IMPLICIT NONE
-
-c=======================================================================
-c
-c   Auteur:  P. Le Van / L.Fairhead
-c   -------
-c
-c   objet:
-c   ------
-c
-c   Lecture de l'etat initial
-c
-c=======================================================================
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "temps.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "ener.h"
-#include "netcdf.inc"
-#include "description.h"
-#include "serre.h"
-#include "logic.h"
-#include "iniprint.h"
-
-c   Arguments:
-c   ----------
-
-      CHARACTER*(*) fichnom
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
-      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
-      REAL ps(ip1jmp1),phis(ip1jmp1)
-
-      REAL time
-
-c   Variables 
-c
-      INTEGER length,iq
-      PARAMETER (length = 100)
-      REAL tab_cntrl(length) ! tableau des parametres du run
-      INTEGER ierr, nid, nvarid
-
-c-----------------------------------------------------------------------
-
-c  Ouverture NetCDF du fichier etat initial
-
-      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
-        write(lunout,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <controle> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
-         CALL abort
-      ENDIF
-
-      im         = tab_cntrl(1)
-      jm         = tab_cntrl(2)
-      lllm       = tab_cntrl(3)
-      day_ref    = tab_cntrl(4)
-      annee_ref  = tab_cntrl(5)
-      rad        = tab_cntrl(6)
-      omeg       = tab_cntrl(7)
-      g          = tab_cntrl(8)
-      cpp        = tab_cntrl(9)
-      kappa      = tab_cntrl(10)
-      daysec     = tab_cntrl(11)
-      dtvr       = tab_cntrl(12)
-      etot0      = tab_cntrl(13)
-      ptot0      = tab_cntrl(14)
-      ztot0      = tab_cntrl(15)
-      stot0      = tab_cntrl(16)
-      ang0       = tab_cntrl(17)
-      pa         = tab_cntrl(18)
-      preff      = tab_cntrl(19)
-c
-      clon       = tab_cntrl(20)
-      clat       = tab_cntrl(21)
-      grossismx  = tab_cntrl(22)
-      grossismy  = tab_cntrl(23)
-c
-      IF ( tab_cntrl(24).EQ.1. )  THEN
-        fxyhypb  = . TRUE .
-c        dzoomx   = tab_cntrl(25)
-c        dzoomy   = tab_cntrl(26)
-c        taux     = tab_cntrl(28)
-c        tauy     = tab_cntrl(29)
-      ELSE
-        fxyhypb = . FALSE .
-        ysinus  = . FALSE .
-        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE. 
-      ENDIF
-
-      day_ini = tab_cntrl(30)
-      itau_dyn = tab_cntrl(31)
-c   .................................................................
-c
-c
-      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
-     &               rad,omeg,g,cpp,kappa
-
-      IF(   im.ne.iim           )  THEN
-          PRINT 1,im,iim
-          STOP
-      ELSE  IF( jm.ne.jjm       )  THEN
-          PRINT 2,jm,jjm
-          STOP
-      ELSE  IF( lllm.ne.llm     )  THEN
-          PRINT 3,lllm,llm
-          STOP
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "cu", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <cu> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "cv", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <cv> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "aire", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <aire> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "temps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <temps> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee <temps>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
-         CALL abort
-      ENDIF
- 
-      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "teta", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <teta> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
-         CALL abort
-      ENDIF
-
-
-      IF(nqtot.GE.1) THEN
-      DO iq=1,nqtot
-        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
-        IF (ierr .NE. NF_NOERR) THEN
-           write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
-     &                    "> est absent"
-           write(lunout,*)"          Il est donc initialise a zero"
-           q(:,:,iq)=0.
-        ELSE
-#ifdef NC_DOUBLE
-          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,iq))
-#else
-          ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,iq))
-#endif
-          IF (ierr .NE. NF_NOERR) THEN
-            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
-            CALL abort
-          ENDIF
-        ENDIF
-      ENDDO
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "masse", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <masse> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_INQ_VARID (nid, "ps", nvarid)
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Le champ <ps> est absent"
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
-#endif
-      IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
-         CALL abort
-      ENDIF
-
-      ierr = NF_CLOSE(nid)
-
-       day_ini=day_ini+INT(time)
-       time=time-INT(time)
-
-  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
-     *arrage est differente de la valeur parametree iim =',i4//)
-   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
-     *arrage est differente de la valeur parametree jjm =',i4//)
-   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
-     *rrage est differente de la valeur parametree llm =',i4//)
-   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
-     *rrage est differente de la valeur  dtinteg =',i4//)
-
-      RETURN
-      END
Index: /LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F	(revision 1673)
@@ -5,4 +5,5 @@
      .                    teta,q,masse,ps,phis,time)
       USE infotrac
+      use control_mod, only : planet_type
       USE parallel
       IMPLICIT NONE
@@ -57,4 +58,6 @@
       REAL,ALLOCATABLE :: phis_glo(:)
 
+      INTEGER idecal
+
 c-----------------------------------------------------------------------
 c  Ouverture NetCDF du fichier etat initial
@@ -84,30 +87,42 @@
       ENDIF
 
+      !!! AS: idecal is a hack to be able to read planeto starts...
+      !!!     .... while keeping everything OK for LMDZ EARTH
+      if (planet_type.eq."generic") then
+          print*,'NOTE NOTE NOTE : Planeto-like start files'
+          idecal = 4
+          annee_ref  = 2000
+      else
+          print*,'NOTE NOTE NOTE : Earth-like start files'
+          idecal = 5
+          annee_ref  = tab_cntrl(5)
+      endif
+
+
       im         = tab_cntrl(1)
       jm         = tab_cntrl(2)
       lllm       = tab_cntrl(3)
       day_ref    = tab_cntrl(4)
-      annee_ref  = tab_cntrl(5)
-      rad        = tab_cntrl(6)
-      omeg       = tab_cntrl(7)
-      g          = tab_cntrl(8)
-      cpp        = tab_cntrl(9)
-      kappa      = tab_cntrl(10)
-      daysec     = tab_cntrl(11)
-      dtvr       = tab_cntrl(12)
-      etot0      = tab_cntrl(13)
-      ptot0      = tab_cntrl(14)
-      ztot0      = tab_cntrl(15)
-      stot0      = tab_cntrl(16)
-      ang0       = tab_cntrl(17)
-      pa         = tab_cntrl(18)
-      preff      = tab_cntrl(19)
-c
-      clon       = tab_cntrl(20)
-      clat       = tab_cntrl(21)
-      grossismx  = tab_cntrl(22)
-      grossismy  = tab_cntrl(23)
-c
-      IF ( tab_cntrl(24).EQ.1. )  THEN
+      rad        = tab_cntrl(idecal+1)
+      omeg       = tab_cntrl(idecal+2)
+      g          = tab_cntrl(idecal+3)
+      cpp        = tab_cntrl(idecal+4)
+      kappa      = tab_cntrl(idecal+5)
+      daysec     = tab_cntrl(idecal+6)
+      dtvr       = tab_cntrl(idecal+7)
+      etot0      = tab_cntrl(idecal+8)
+      ptot0      = tab_cntrl(idecal+9)
+      ztot0      = tab_cntrl(idecal+10)
+      stot0      = tab_cntrl(idecal+11)
+      ang0       = tab_cntrl(idecal+12)
+      pa         = tab_cntrl(idecal+13)
+      preff      = tab_cntrl(idecal+14)
+c
+      clon       = tab_cntrl(idecal+15)
+      clat       = tab_cntrl(idecal+16)
+      grossismx  = tab_cntrl(idecal+17)
+      grossismy  = tab_cntrl(idecal+18)
+c
+      IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
         fxyhypb  = . TRUE .
 c        dzoomx   = tab_cntrl(25)
@@ -118,5 +133,5 @@
         fxyhypb = . FALSE .
         ysinus  = . FALSE .
-        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE. 
+        IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. 
       ENDIF
 
@@ -266,6 +281,11 @@
       ierr = NF_INQ_VARID (nid, "temps", nvarid)
       IF (ierr .NE. NF_NOERR) THEN
-         write(lunout,*)"dynetat0_loc: Le champ <temps> est absent"
-         CALL abort
+         write(lunout,*)"dynetat0: Le champ <temps> est absent"
+         write(lunout,*)"dynetat0: J essaie <Time>"
+         ierr = NF_INQ_VARID (nid, "Time", nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            write(lunout,*)"dynetat0: Le champ <Time> est absent"
+            CALL abort
+         ENDIF
       ENDIF
 #ifdef NC_DOUBLE
Index: /LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: dynredem_p.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id$
 !
 c
@@ -126,4 +126,6 @@
        tab_cntrl(30) =  REAL(iday_end)
        tab_cntrl(31) =  REAL(itau_dyn + itaufin)
+c start_time: start_time of simulation (not necessarily 0.)
+       tab_cntrl(32) = start_time
 c
 c    .........................................................
@@ -635,5 +637,5 @@
       CALL dynredem_write_u(nid,"ps",ps,1)
 
-      IF (config_inca == 'none') THEN
+      IF (type_trac /= 'inca') THEN
         DO iq=1,nqtot
           CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm)
Index: /LMDZ5/trunk/libf/dyn3dmem/ener.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/ener.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/ener.h	(revision 1673)
@@ -1,13 +1,16 @@
 !
-! $Header$
+! $Id$
 !
-!-----------------------------------------------------------------------
+!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
+!                 veillez à n'utiliser que des ! pour les commentaires
+!                 et à bien positionner les & des lignes de continuation 
+!                 (les placer en colonne 6 et en colonne 73)
+!
 ! INCLUDE 'ener.h'
 
-      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                          &
-     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                      &
+      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                         &
+     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                     &
      &            rmsv,gtot(llmm1)
-
-      REAL ang0,etot0,ptot0,ztot0,stot0,                                 &
+      REAL ang0,etot0,ptot0,ztot0,stot0,                                &
      &     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
 
Index: /LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/etat0_netcdf.F90	(revision 1673)
@@ -1,8 +1,8 @@
 !
-! $Id: etat0_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
+! $Id$
 !
 !-------------------------------------------------------------------------------
 !
-SUBROUTINE etat0_netcdf(ib, masque, letat0)
+SUBROUTINE etat0_netcdf(ib, masque, phis, letat0)
 !
 !-------------------------------------------------------------------------------
@@ -37,4 +37,5 @@
   LOGICAL,                    INTENT(IN)    :: ib     ! barycentric interpolat.
   REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: masque ! land mask
+  REAL, DIMENSION(iip1,jjp1), INTENT(OUT)   :: phis   ! geopotentiel au sol
   LOGICAL,                    INTENT(IN)    :: letat0 ! F: masque only required
 #ifndef CPP_EARTH
@@ -51,5 +52,5 @@
   REAL,    DIMENSION(klon)                 :: tsol, qsol
   REAL,    DIMENSION(klon)                 :: sn, rugmer, run_off_lic_0
-  REAL,    DIMENSION(iip1,jjp1)            :: orog, rugo, psol, phis
+  REAL,    DIMENSION(iip1,jjp1)            :: orog, rugo, psol
   REAL,    DIMENSION(iip1,jjp1,llm+1)      :: p3d
   REAL,    DIMENSION(iip1,jjp1,llm)        :: uvent, t3d, tpot, qsat, qd
@@ -98,5 +99,5 @@
   REAL    :: dummy
   LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf
-  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod
+  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod, callstats
   INTEGER :: iflag_radia, flag_aerosol
   REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
@@ -130,4 +131,5 @@
 !--- CONSTRUCT A GRID
   CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
+                   callstats,                                           &
                    solarlong0,seuil_inversion,                          &
                    fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
@@ -137,7 +139,5 @@
                    flag_aerosol, new_aod,                               &
                    bl95_b0, bl95_b1,                                    &
-                   iflag_thermals,nsplit_thermals,tau_thermals,         &
-                   iflag_thermals_ed,iflag_thermals_optflux,            &
-                   iflag_coupl,iflag_clos,iflag_wake, read_climoz,      &
+                   read_climoz,                                         &
                    alp_offset)
 
@@ -251,5 +251,9 @@
 !*******************************************************************************
   CALL pression(ip1jmp1, ap, bp, psol, p3d)
-  CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
+  if (pressure_exner) then
+    CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
+  else
+    CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y)
+  endif
   pls(:,:,:)=preff*(pk(:,:,:)/cpp)**(1./kappa)
 !  WRITE(lunout,*) 'P3D :', p3d(10,20,:)
Index: /LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: exner_hyb.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id$
 !
       SUBROUTINE  exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
@@ -51,17 +51,25 @@
       REAL SSUM
 c
+      logical,save :: firstcall=.true.
+      character(len=*),parameter :: modname="exner_hyb"
+      
+      ! Sanity check
+      if (firstcall) then
+        ! sanity checks for Shallow Water case (1 vertical layer)
+        if (llm.eq.1) then
+          if (kappa.ne.1) then
+            call abort_gcm(modname,
+     &      "kappa!=1 , but running in Shallow Water mode!!",42)
+          endif
+          if (cpp.ne.r) then
+            call abort_gcm(modname,
+     &      "cpp!=r , but running in Shallow Water mode!!",42)
+          endif
+        endif ! of if (llm.eq.1)
+
+        firstcall=.false.
+      endif ! of if (firstcall)
 
       if (llm.eq.1) then
-        ! Specific behaviour for Shallow Water (1 vertical layer) case
-      
-        ! Sanity checks
-        if (kappa.ne.1) then
-          call abort_gcm("exner_hyb",
-     &    "kappa!=1 , but running in Shallow Water mode!!",42)
-        endif
-        if (cpp.ne.r) then
-        call abort_gcm("exner_hyb",
-     &    "cpp!=r , but running in Shallow Water mode!!",42)
-        endif
         
         ! Compute pks(:),pk(:),pkf(:)
@@ -77,6 +85,8 @@
         ! our work is done, exit routine
         return
+
       endif ! of if (llm.eq.1)
 
+!!!! General case:
      
       unpl2k    = 1.+ 2.* kappa
Index: /LMDZ5/trunk/libf/dyn3dmem/exner_hyb_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/exner_hyb_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/exner_hyb_loc.F	(revision 1673)
@@ -57,19 +57,31 @@
       EXTERNAL SSUM
       INTEGER ije,ijb,jje,jjb
+      logical,save :: firstcall=.true.
+!$OMP THREADPRIVATE(firstcall) 
+      character(len=*),parameter :: modname="exner_hyb_loc"
 c
 c$OMP BARRIER           
 
+      ! Sanity check
+      if (firstcall) then
+        ! sanity checks for Shallow Water case (1 vertical layer)
+        if (llm.eq.1) then
+          if (kappa.ne.1) then
+            call abort_gcm(modname,
+     &      "kappa!=1 , but running in Shallow Water mode!!",42)
+          endif
+          if (cpp.ne.r) then
+            call abort_gcm(modname,
+     &      "cpp!=r , but running in Shallow Water mode!!",42)
+          endif
+        endif ! of if (llm.eq.1)
+
+        firstcall=.false.
+      endif ! of if (firstcall)
+
+c$OMP BARRIER
+
+! Specific behaviour for Shallow Water (1 vertical layer) case
       if (llm.eq.1) then
-        ! Specific behaviour for Shallow Water (1 vertical layer) case
-      
-        ! Sanity checks
-        if (kappa.ne.1) then
-          call abort_gcm("exner_hyb",
-     &    "kappa!=1 , but running in Shallow Water mode!!",42)
-        endif
-        if (cpp.ne.r) then
-        call abort_gcm("exner_hyb",
-     &    "cpp!=r , but running in Shallow Water mode!!",42)
-        endif
         
         ! Compute pks(:),pk(:),pkf(:)
@@ -111,5 +123,5 @@
       endif
 !$OMP END MASTER
-
+!$OMP BARRIER
         jjb=jj_begin
         jje=jj_end
Index: /LMDZ5/trunk/libf/dyn3dmem/exner_milieu.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/exner_milieu.F	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/exner_milieu.F	(revision 1673)
@@ -0,0 +1,144 @@
+!
+! $Id$
+!
+      SUBROUTINE  exner_milieu ( ngrid, ps, p,beta, pks, pk, pkf )
+c
+c     Auteurs :  F. Forget , Y. Wanherdrick
+c P.Le Van  , Fr. Hourdin  .
+c    ..........
+c
+c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
+c    .... beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
+c
+c   ************************************************************************
+c    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des 
+c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
+c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
+c   ************************************************************************
+c    .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
+c    la pression et la fonction d'Exner  au  sol  .
+c
+c     WARNING : CECI est une version speciale de exner_hyb originale
+c               Utilise dans la version martienne pour pouvoir 
+c               tourner avec des coordonnees verticales complexe
+c              => Il ne verifie PAS la condition la proportionalite en 
+c              energie totale/ interne / potentielle (F.Forget 2001)
+c    ( voir note de Fr.Hourdin )  ,
+c
+      IMPLICIT NONE
+c
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comgeom.h"
+#include "comvert.h"
+#include "serre.h"
+
+      INTEGER  ngrid
+      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
+      REAL ps(ngrid),pks(ngrid), beta(ngrid,llm)
+
+c    .... variables locales   ...
+
+      INTEGER l, ij
+      REAL dum1
+
+      REAL ppn(iim),pps(iim)
+      REAL xpn, xps
+      REAL SSUM
+      EXTERNAL SSUM
+      logical,save :: firstcall=.true.
+      character(len=*),parameter :: modname="exner_milieu"
+
+      ! Sanity check
+      if (firstcall) then
+        ! sanity checks for Shallow Water case (1 vertical layer)
+        if (llm.eq.1) then
+          if (kappa.ne.1) then
+            call abort_gcm(modname,
+     &      "kappa!=1 , but running in Shallow Water mode!!",42)
+          endif
+          if (cpp.ne.r) then
+            call abort_gcm(modname,
+     &      "cpp!=r , but running in Shallow Water mode!!",42)
+          endif
+        endif ! of if (llm.eq.1)
+
+        firstcall=.false.
+      endif ! of if (firstcall)
+
+!!!! Specific behaviour for Shallow Water (1 vertical layer) case:
+      if (llm.eq.1) then
+      
+        ! Compute pks(:),pk(:),pkf(:)
+        
+        DO   ij  = 1, ngrid
+          pks(ij) = (cpp/preff) * ps(ij) 
+          pk(ij,1) = .5*pks(ij)
+        ENDDO
+        
+        CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+        CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 
+        
+        ! our work is done, exit routine
+        return
+
+      endif ! of if (llm.eq.1)
+
+!!!! General case:
+
+c     -------------
+c     Calcul de pks
+c     -------------
+   
+      DO   ij  = 1, ngrid
+        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
+      ENDDO
+
+      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
+c
+c
+c    .... Calcul de pk  pour la couche l 
+c    --------------------------------------------
+c
+      dum1 = cpp * (2*preff)**(-kappa) 
+      DO l = 1, llm-1
+        DO   ij   = 1, ngrid
+         pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
+        ENDDO
+      ENDDO
+
+c    .... Calcul de pk  pour la couche l = llm ..
+c    (on met la meme distance (en log pression)  entre Pk(llm)
+c    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
+
+      DO   ij   = 1, ngrid
+         pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
+      ENDDO
+
+
+c    calcul de pkf
+c    -------------
+      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
+      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
+      
+c    EST-CE UTILE ?? : calcul de beta
+c    --------------------------------
+      DO l = 2, llm
+        DO   ij   = 1, ngrid
+          beta(ij,l) = pk(ij,l) / pk(ij,l-1)   
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: /LMDZ5/trunk/libf/dyn3dmem/exner_milieu_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/exner_milieu_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/exner_milieu_loc.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id $
+! $Id$
 !
       SUBROUTINE  exner_milieu_loc ( ngrid, ps, p,beta, pks, pk, pkf )
@@ -54,14 +54,8 @@
       logical,save :: firstcall=.true.
 !$OMP THREADPRIVATE(firstcall) 
-      character(len=*),parameter :: modname="exner_milieu_p"
+      character(len=*),parameter :: modname="exner_milieu_loc"
 
       ! Sanity check
       if (firstcall) then
-        ! check that vertical discretization is compatible
-        ! with this routine
-        if (disvert_type.ne.2) then
-          call abort_gcm(modname,
-     &     "this routine should only be called if disvert_type==2",42)
-        endif
         
         ! sanity checks for Shallow Water case (1 vertical layer)
@@ -123,5 +117,5 @@
       endif
 !$OMP END MASTER
-
+!$OMP BARRIER
         jjb=jj_begin
         jje=jj_end
@@ -171,4 +165,5 @@
       endif
 c$OMP END MASTER
+c$OMP BARRIER
 c
 c
Index: /LMDZ5/trunk/libf/dyn3dmem/filtreg_p.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/filtreg_p.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/filtreg_p.F	(revision 1673)
@@ -208,24 +208,39 @@
                IF( ifiltre.EQ.-2 )   THEN
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matrinvn(1,1,j), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0,
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matrinvn(:,:,j),champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
                ELSE IF ( griscal )     THEN
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matriceun(1,1,j), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0,
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matriceun(:,:,j),champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
                ELSE 
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matricevn(1,1,j), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matricevn(:,:,j),champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
@@ -236,8 +251,14 @@
                IF( ifiltre.EQ.-2 )   THEN
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matrinvs(1,1,j-jfiltsu+1), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matrinvs(:,:,j-jfiltsu+1),
+     &                            champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
@@ -245,8 +266,14 @@
                   
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matriceus(1,1,j-jfiltsu+1), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matriceus(:,:,j-jfiltsu+1),
+     &                            champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
@@ -254,8 +281,14 @@
                   
                   DO j = jdfil,jffil
+#ifdef BLAS
                      CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0, 
      &                    matricevs(1,1,j-jfiltsv+1), iim, 
      &                    champ_loc(1,j,1), iip1*nlat, 0.0, 
      &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
+#else
+                     champ_fft(:,j-jdfil+1,:)
+     &                    =matmul(matricevs(:,:,j-jfiltsv+1),
+     &                            champ_loc(:iim,j,:))
+#endif
                   ENDDO
                   
Index: /LMDZ5/trunk/libf/dyn3dmem/friction_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/friction_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/friction_loc.F	(revision 1673)
@@ -6,17 +6,23 @@
       USE parallel
       USE control_mod
+#ifdef CPP_IOIPSL
+      USE IOIPSL
+#else
+! if not using IOIPSL, we still need to use (a local version of) getin
+      USE ioipsl_getincom
+#endif
       IMPLICIT NONE
 
-c=======================================================================
-c
-c
-c   Objet:
-c   ------
-c
-c  ***********
-c    Friction
-c  ***********
-c
-c=======================================================================
+!=======================================================================
+!
+!   Friction for the Newtonian case:
+!   --------------------------------
+!    2 possibilities (depending on flag 'friction_type'
+!     friction_type=0 : A friction that is only applied to the lowermost
+!                       atmospheric layer
+!     friction_type=1 : Friction applied on all atmospheric layer (but
+!       (default)       with stronger magnitude near the surface; see
+!                       iniacademic.F)
+!=======================================================================
 
 #include "dimensions.h"
@@ -24,16 +30,41 @@
 #include "comgeom2.h"
 #include "comconst.h"
-
-      REAL pdt
+#include "iniprint.h"
+#include "academic.h"
+
+! arguments:
+      REAL,INTENT(inout) :: ucov( iip1,jjb_u:jje_u,llm )
+      REAL,INTENT(inout) :: vcov( iip1,jjb_v:jje_v,llm )
+      REAL,INTENT(in) :: pdt ! time step
+
+! local variables:
+
       REAL modv(iip1,jjb_u:jje_u),zco,zsi
       REAL vpn,vps,upoln,upols,vpols,vpoln
       REAL u2(iip1,jjb_u:jje_u),v2(iip1,jjb_v:jje_v)
-      REAL ucov( iip1,jjb_u:jje_u,llm ),vcov( iip1,jjb_v:jje_v,llm )
-      INTEGER  i,j
-      REAL cfric
-      parameter (cfric=1.e-5)
+      INTEGER  i,j,l
+      REAL,PARAMETER :: cfric=1.e-5
+      LOGICAL,SAVE :: firstcall=.true.
+      INTEGER,SAVE :: friction_type=1
+      CHARACTER(len=20) :: modname="friction_p"
+      CHARACTER(len=80) :: abort_message
+!$OMP THREADPRIVATE(firstcall,friction_type)
       integer :: jjb,jje
 
-
+!$OMP SINGLE
+      IF (firstcall) THEN
+        ! set friction type
+        call getin("friction_type",friction_type)
+        if ((friction_type.lt.0).or.(friction_type.gt.1)) then
+          abort_message="wrong friction type"
+          write(lunout,*)'Friction: wrong friction type',friction_type
+          call abort_gcm(modname,abort_message,42)
+        endif
+        firstcall=.false.
+      ENDIF
+!$OMP END SINGLE COPYPRIVATE(friction_type,firstcall)
+
+      if (friction_type.eq.0) then ! friction on first layer only
+!$OMP SINGLE
 c   calcul des composantes au carre du vent naturel
       jjb=jj_begin
@@ -138,4 +169,33 @@
          vcov(iip1,j,1)=vcov(1,j,1)
       enddo
+!$OMP END SINGLE
+      endif ! of if (friction_type.eq.0)
+
+      if (friction_type.eq.1) then
+       ! for ucov() 
+        jjb=jj_begin
+        jje=jj_end
+        if (pole_nord) jjb=jj_begin+1
+        if (pole_sud) jje=jj_end-1
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        do l=1,llm
+          ucov(1:iip1,jjb:jje,l)=ucov(1:iip1,jjb:jje,l)*
+     &                                  (1.-pdt*kfrict(l))
+        enddo
+!$OMP END DO NOWAIT
+        
+       ! for vcoc()
+        jjb=jj_begin
+        jje=jj_end
+        if (pole_sud) jje=jj_end-1
+        
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+        do l=1,llm
+          vcov(1:iip1,jjb:jje,l)=vcov(1:iip1,jjb:jje,l)*
+     &                                  (1.-pdt*kfrict(l))
+        enddo
+!$OMP END DO
+      endif ! of if (friction_type.eq.1)
 
       RETURN
Index: /LMDZ5/trunk/libf/dyn3dmem/gcm.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gcm.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/gcm.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: gcm.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id$
 !
 c
@@ -20,6 +20,5 @@
       USE control_mod
 
-! Ehouarn: for now these only apply to Earth:
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
       USE mod_grid_phy_lmdz
       USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
@@ -87,6 +86,4 @@
 
       REAL zdtvr
-c      INTEGER nbetatmoy, nbetatdem,nbetat
-      INTEGER nbetatmoy, nbetatdem
 
 c   variables dynamiques
@@ -189,13 +186,10 @@
       call ini_getparam("out.def")
       call Read_Distrib
-! Ehouarn : temporarily (?) keep this only for Earth
-      if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+
+#ifdef CPP_PHYS
         CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
 #endif
-      endif ! of if (planet_type.eq."earth")
       CALL set_bands
-#ifdef CPP_EARTH
-! Ehouarn: For now only Earth physics is parallel
+#ifdef CPP_PHYS
       CALL Init_interface_dyn_phys
 #endif
@@ -209,12 +203,9 @@
 c$OMP END PARALLEL
 
-! Ehouarn : temporarily (?) keep this only for Earth
-      if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 c$OMP PARALLEL
       call InitComgeomphy
 c$OMP END PARALLEL 
 #endif
-      endif ! of if (planet_type.eq."earth")
 
 c-----------------------------------------------------------------------
@@ -240,5 +231,5 @@
 #endif
 
-      IF (config_inca /= 'none') THEN
+      IF (type_trac == 'inca') THEN
 #ifdef INCA
          call init_const_lmdz(
@@ -282,18 +273,10 @@
         endif
 
-        if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
+!        if (planet_type.eq."earth") then
 ! Load an Earth-format start file
          CALL dynetat0_loc("start.nc",vcov,ucov,
      &              teta,q,masse,ps,phis, time_0)
-#else
-        ! SW model also has Earth-format start files
-        ! (but can be used without the CPP_EARTH directive)
-          if (iflag_phys.eq.0) then
-            CALL dynetat0_loc("start.nc",vcov,ucov,
-     &              teta,q,masse,ps,phis, time_0)
-          endif
-#endif
-        endif ! of if (planet_type.eq."earth")
+!        endif ! of if (planet_type.eq."earth")
+
 c       write(73,*) 'ucov',ucov
 c       write(74,*) 'vcov',vcov
@@ -337,4 +320,15 @@
 C on remet le calendrier à zero si demande
 c
+      IF (start_time /= starttime) then
+        WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
+     &,' fichier restart ne correspond pas à celle lue dans le run.def'
+        IF (raz_date == 1) then
+          WRITE(lunout,*)'Je prends l''heure lue dans run.def'
+          start_time = starttime
+        ELSE
+          WRITE(lunout,*)'Je m''arrete'
+          CALL abort
+        ENDIF
+      ENDIF
       IF (raz_date == 1) THEN
         annee_ref = anneeref
@@ -404,23 +398,20 @@
 #endif
 
-c  nombre d'etats dans les fichiers demarrage et histoire
-      nbetatdem = nday / iecri
-      nbetatmoy = nday / periodav + 1
 
 c-----------------------------------------------------------------------
 c   Initialisation des constantes dynamiques :
 c   ------------------------------------------
-      dtvr = zdtvr
-      CALL iniconst
+        dtvr = zdtvr
+        CALL iniconst
 
 c-----------------------------------------------------------------------
 c   Initialisation de la geometrie :
 c   --------------------------------
-      CALL inigeom
+        CALL inigeom
 
 c-----------------------------------------------------------------------
 c   Initialisation du filtre :
 c   --------------------------
-      CALL inifilr
+        CALL inifilr
 c
 c-----------------------------------------------------------------------
@@ -434,5 +425,5 @@
 c   Initialisation de la physique :
 c   -------------------------------
-      IF (call_iniphys.and.iflag_phys.eq.1) THEN
+      IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100)) THEN
          latfi(1)=rlatu(1)
          lonfi(1)=0.
@@ -455,13 +446,12 @@
          WRITE(lunout,*)
      .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
-! Earth:
-         if (planet_type.eq."earth") then
-#ifdef CPP_EARTH
-         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
-     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
-#endif
-         endif ! of if (planet_type.eq."earth")
+! Physics:
+#ifdef CPP_PHYS
+         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys, 
+     &                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp, 
+     &                iflag_phys) 
+#endif
          call_iniphys=.false.
-      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
+      ENDIF ! of IF (call_iniphys.and.(iflag_phys==1.or.iflag_phys>=100))
 
 
@@ -469,5 +459,5 @@
 c   Initialisation des dimensions d'INCA :
 c   --------------------------------------
-      IF (config_inca /= 'none') THEN
+      IF (type_trac == 'inca') THEN
 !$OMP PARALLEL
 #ifdef INCA
@@ -496,7 +486,8 @@
 #endif
 
-      if (planet_type.eq."earth") then
+!      if (planet_type.eq."earth") then
+! Write an Earth-format restart file
         CALL dynredem0_loc("restart.nc", day_end, phis)
-      endif
+!      endif
 
       ecripar = .TRUE.
@@ -544,5 +535,5 @@
 c       write(78,*) 'q',q
 
-c$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logic/)
+c$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logici/,/logicl/)
       CALL leapfrog_loc(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
      .              time_0)
Index: /LMDZ5/trunk/libf/dyn3dmem/gr_dyn_fi_p.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_dyn_fi_p.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/gr_dyn_fi_p.F	(revision 1673)
@@ -1,9 +1,8 @@
 !
-! $Id: gr_dyn_fi_p.F 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
       SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Interface with parallel physics,
-! for now this routine only works with Earth physics
       USE mod_interface_dyn_phys
       USE dimphy
@@ -40,10 +39,6 @@
       ENDDO
 c$OMP END DO NOWAIT
-#else
-      write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
-     &   "without parallelized physics"
-      stop
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_PHYS
       RETURN
       END
Index: /LMDZ5/trunk/libf/dyn3dmem/gr_fi_dyn_p.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/gr_fi_dyn_p.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/gr_fi_dyn_p.F	(revision 1673)
@@ -1,9 +1,8 @@
 !
-! $Id: gr_fi_dyn_p.F 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
       SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Interface with parallel physics,
-! for now this routine only works with Earth physics
       USE mod_interface_dyn_phys
       USE dimphy
@@ -52,10 +51,6 @@
       ENDDO
 c$OMP END DO NOWAIT
-#else
-      write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
-     &   "without parallelized physics"
-      stop
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_PHYS
       RETURN
       END
Index: /LMDZ5/trunk/libf/dyn3dmem/grid_noro.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/grid_noro.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/grid_noro.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: grid_noro.F 1403 2010-07-01 09:02:53Z fairhead $
+! $Id$
 !
 c
@@ -458,10 +458,7 @@
 C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
 
-      PARAMETER (ISMo=300,JSMo=200)
-      REAL X(IMAR,JMAR),XF(ISMo,JSMo)
+      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
       real WEIGHTpb(-1:1,-1:1)
 
-      if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
-      if(jmar.gt.jsmo) stop'surdimensionner jsmo dans mva9 (grid_noro)'
       
       SUM=0.
Index: /LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf_sub.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf_sub.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/grilles_gcm_netcdf_sub.F90	(revision 1673)
@@ -0,0 +1,237 @@
+!
+! $Id$
+!
+! This subroutine creates the file grilles_gcm.nc containg longitudes and
+! latitudes in degrees for grid u and v. This subroutine is called from
+! ce0l if grilles_gcm_netcdf=TRUE. This subroutine corresponds to the first 
+! part in the program create_fausse_var.
+!
+SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)
+
+  IMPLICIT NONE
+
+  INCLUDE "dimensions.h"
+  INCLUDE "paramet.h"
+  INCLUDE "comconst.h"
+  INCLUDE "comgeom.h"
+  INCLUDE "comvert.h"
+  INCLUDE "netcdf.inc"
+  INCLUDE "serre.h"
+
+
+  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: masque ! masque terre/mer
+  REAL,DIMENSION(iip1,jjp1),INTENT(IN)  :: phis   ! geopotentiel au sol
+
+  REAL temp(iim+1,jjm+1)
+  ! Attributs netcdf sortie
+  INTEGER ncid_out,rcode_out
+  INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid
+  INTEGER out_varid
+  INTEGER out_lonudim,out_lonvdim
+  INTEGER out_latudim,out_latvdim,out_dim(3)
+  INTEGER out_levdim
+
+  INTEGER, PARAMETER :: longcles = 20
+  REAL  clesphy0(longcles)
+
+  INTEGER start(4),COUNT(4)
+
+  INTEGER status,i,j
+  REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm)
+  REAL rlonudeg(iip1),rlonvdeg(iip1)
+
+  REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1)
+  REAL acoslat,dxkm,dykm,resol(iip1,jjp1)
+  REAL,DIMENSION(iip1,jjp1)  :: phis_loc
+  INTEGER masque_int(iip1,jjp1)
+  INTEGER :: phis_id
+  INTEGER :: area_id
+  INTEGER :: mask_id
+  
+  rad = 6400000
+  omeg = 7.272205e-05
+  g = 9.8
+  kappa = 0.285716
+  daysec = 86400
+  cpp = 1004.70885
+
+  preff = 101325.
+  pa= 50000.
+
+  CALL conf_gcm( 99, .TRUE. , clesphy0 )
+  CALL iniconst
+  CALL inigeom
+
+  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 + 360.
+     rlonvdeg(i)=rlonv(i)*180./pi + 360.
+  ENDDO
+
+
+  !  2 ----- OUVERTURE DE LA SORTIE NETCDF
+  ! ---------------------------------------------------
+  ! CREATION OUTPUT
+  ! ouverture fichier netcdf de sortie out
+  status=NF_CREATE('grilles_gcm.nc',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)
+
+
+  !   Longitudes en u
+  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')
+
+  !   Longitudes en v
+  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')
+
+  !   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')
+
+  !  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')
+
+  !   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')
+
+  !   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')
+
+  !   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')
+
+  status=NF_ENDDEF(ncid_out)
+  ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------
+  ! --------------------------------------------------------
+  ! 3-b- Ecriture de la grille pour la sortie
+  ! 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, count,temp)
+#else
+  status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp)
+#endif
+
+  ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA
+! lev - phis - aire - mask
+  rlevdeg(:) = presnivs
+  phis_loc(:,:) = phis(:,:)/g
+
+! niveaux de pression verticaux
+  status = NF_REDEF (ncid_out)
+  status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim)
+  
+! fields
+  out_dim(1)=out_lonvdim
+  out_dim(2)=out_latudim
+
+  status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id)
+  CALL handle_err(status)
+  status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id)
+  CALL handle_err(status)
+  status = nf_def_var(ncid_out,'mask',NF_INT  ,2,out_dim,mask_id)
+  CALL handle_err(status)
+
+  status=NF_ENDDEF(ncid_out)
+
+  ! ecriture des variables
+#ifdef NC_DOUBLE
+  status=NF_PUT_VARA_DOUBLE(ncid_out,out_levid,1,llm,rlevdeg)
+#else
+  status=NF_PUT_VARA_REAL(ncid_out,out_levid,1,llm,rlevdeg)
+#endif
+
+  start(1)=1
+  start(2)=1
+  start(3)=1
+  start(4)=0
+  COUNT(1)=iip1
+  COUNT(2)=jjp1
+  COUNT(3)=1
+  COUNT(4)=0
+
+  status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc)
+  status = nf_put_vara_double(ncid_out, area_id,start,count, aire)
+  masque_int(:,:) = nINT(masque(:,:))
+  status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int)
+  CALL handle_err(status)
+  
+  ! fermeture du fichier netcdf
+  CALL ncclos(ncid_out,rcode_out)
+
+END SUBROUTINE grilles_gcm_netcdf_sub
+
+
+
+SUBROUTINE handle_err(status)
+  INCLUDE "netcdf.inc"
+
+  INTEGER status
+  IF (status.NE.nf_noerr) THEN
+     PRINT *,NF_STRERROR(status)
+     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)
+  ENDIF
+END SUBROUTINE handle_err
+
Index: /LMDZ5/trunk/libf/dyn3dmem/guide_loc_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/guide_loc_mod.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/guide_loc_mod.F90	(revision 1673)
@@ -467,5 +467,5 @@
 !       Calcul niveaux pression milieu de couches 
 	CALL pression_loc( ijnb_u, ap, bp, ps, p )
-	if (disvert_type==1) then
+	if (pressure_exner) then
           CALL exner_hyb_loc(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
 	else
Index: DZ5/trunk/libf/dyn3dmem/guide_p_mod.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/guide_p_mod.F90	(revision 1672)
+++ 	(revision )
@@ -1,1646 +1,0 @@
-!
-! $Id$
-!
-MODULE guide_p_mod
-
-!=======================================================================
-!   Auteur:  F.Hourdin
-!            F. Codron 01/09
-!=======================================================================
-
-  USE getparam
-  USE Write_Field_p
-  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close
-
-  IMPLICIT NONE
-
-! ---------------------------------------------
-! Declarations des cles logiques et parametres 
-! ---------------------------------------------
-  INTEGER, PRIVATE, SAVE  :: iguide_read,iguide_int,iguide_sav
-  INTEGER, PRIVATE, SAVE  :: nlevnc
-  LOGICAL, PRIVATE, SAVE  :: guide_u,guide_v,guide_T,guide_Q,guide_P
-  LOGICAL, PRIVATE, SAVE  :: guide_hr,guide_teta  
-  LOGICAL, PRIVATE, SAVE  :: guide_BL,guide_reg,guide_add,gamma4,guide_zon 
-  LOGICAL, PRIVATE, SAVE  :: guide_modele,invert_p,invert_y,ini_anal
-  LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav
-  
-  REAL, PRIVATE, SAVE     :: tau_min_u,tau_max_u
-  REAL, PRIVATE, SAVE     :: tau_min_v,tau_max_v
-  REAL, PRIVATE, SAVE     :: tau_min_T,tau_max_T
-  REAL, PRIVATE, SAVE     :: tau_min_Q,tau_max_Q
-  REAL, PRIVATE, SAVE     :: tau_min_P,tau_max_P
-
-  REAL, PRIVATE, SAVE     :: lat_min_g,lat_max_g
-  REAL, PRIVATE, SAVE     :: lon_min_g,lon_max_g
-  REAL, PRIVATE, SAVE     :: tau_lon,tau_lat
-
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_u,alpha_v 
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_T,alpha_Q 
-  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: alpha_P,alpha_pcor
-  
-! ---------------------------------------------
-! Variables de guidage
-! ---------------------------------------------
-! Variables des fichiers de guidage
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: unat1,unat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: vnat1,vnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: tnat1,tnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: qnat1,qnat2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: psnat1,psnat2
-  REAL, ALLOCATABLE, DIMENSION(:),     PRIVATE, SAVE   :: apnc,bpnc
-! Variables aux dimensions du modele
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: ugui1,ugui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: vgui1,vgui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: tgui1,tgui2
-  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: qgui1,qgui2
-  REAL, ALLOCATABLE, DIMENSION(:),   PRIVATE, SAVE   :: psgui1,psgui2
-  
-  INTEGER,SAVE,PRIVATE :: ijb_u,ijb_v,ije_u,ije_v,ijn_u,ijn_v
-  INTEGER,SAVE,PRIVATE :: jjb_u,jjb_v,jje_u,jje_v,jjn_u,jjn_v
-
-
-CONTAINS
-!=======================================================================
-
-  SUBROUTINE guide_init
-
-    USE control_mod
-    IMPLICIT NONE
-  
-    INCLUDE "dimensions.h"
-    INCLUDE "paramet.h"
-    INCLUDE "netcdf.inc"
-
-    INTEGER                :: error,ncidpl,rid,rcod
-    CHARACTER (len = 80)   :: abort_message
-    CHARACTER (len = 20)   :: modname = 'guide_init'
-
-! ---------------------------------------------
-! Lecture des parametres:  
-! ---------------------------------------------
-! Variables guidees
-    CALL getpar('guide_u',.true.,guide_u,'guidage de u')
-    CALL getpar('guide_v',.true.,guide_v,'guidage de v')
-    CALL getpar('guide_T',.true.,guide_T,'guidage de T')
-    CALL getpar('guide_P',.true.,guide_P,'guidage de P')
-    CALL getpar('guide_Q',.true.,guide_Q,'guidage de Q')
-    CALL getpar('guide_hr',.true.,guide_hr,'guidage de Q par H.R')
-    CALL getpar('guide_teta',.false.,guide_teta,'guidage de T par Teta')
-
-    CALL getpar('guide_add',.false.,guide_add,'for�age constant?')
-    CALL getpar('guide_zon',.false.,guide_zon,'guidage moy zonale')
-
-!   Constantes de rappel. Unite : fraction de jour
-    CALL getpar('tau_min_u',0.02,tau_min_u,'Cste de rappel min, u')
-    CALL getpar('tau_max_u', 10.,tau_max_u,'Cste de rappel max, u')
-    CALL getpar('tau_min_v',0.02,tau_min_v,'Cste de rappel min, v')
-    CALL getpar('tau_max_v', 10.,tau_max_v,'Cste de rappel max, v')
-    CALL getpar('tau_min_T',0.02,tau_min_T,'Cste de rappel min, T')
-    CALL getpar('tau_max_T', 10.,tau_max_T,'Cste de rappel max, T')
-    CALL getpar('tau_min_Q',0.02,tau_min_Q,'Cste de rappel min, Q')
-    CALL getpar('tau_max_Q', 10.,tau_max_Q,'Cste de rappel max, Q')
-    CALL getpar('tau_min_P',0.02,tau_min_P,'Cste de rappel min, P')
-    CALL getpar('tau_max_P', 10.,tau_max_P,'Cste de rappel max, P')
-    CALL getpar('gamma4',.false.,gamma4,'Zone sans rappel elargie')
-    CALL getpar('guide_BL',.true.,guide_BL,'guidage dans C.Lim')
-    
-! Sauvegarde du for�age
-    CALL getpar('guide_sav',.false.,guide_sav,'sauvegarde guidage')
-    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
-    ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
-    IF (iguide_sav.GT.0) THEN
-        iguide_sav=day_step/iguide_sav
-    ELSE
-        iguide_sav=day_step*iguide_sav
-    ENDIF
-
-! Guidage regional seulement (sinon constant ou suivant le zoom)
-    CALL getpar('guide_reg',.false.,guide_reg,'guidage regional')
-    CALL getpar('lat_min_g',-90.,lat_min_g,'Latitude mini guidage ')
-    CALL getpar('lat_max_g', 90.,lat_max_g,'Latitude maxi guidage ')
-    CALL getpar('lon_min_g',-180.,lon_min_g,'longitude mini guidage ')
-    CALL getpar('lon_max_g', 180.,lon_max_g,'longitude maxi guidage ')
-    CALL getpar('tau_lat', 5.,tau_lat,'raideur lat guide regional ')
-    CALL getpar('tau_lon', 5.,tau_lon,'raideur lon guide regional ')
-
-! Parametres pour lecture des fichiers
-    CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
-    CALL getpar('iguide_int',4,iguide_int,'freq. lecture guidage')
-    IF (iguide_int.GT.0) THEN
-        iguide_int=day_step/iguide_int
-    ELSE
-        iguide_int=day_step*iguide_int
-    ENDIF
-    CALL getpar('guide_modele',.false.,guide_modele,'guidage niveaux modele')
-    CALL getpar('ini_anal',.false.,ini_anal,'Etat initial = analyse')
-    CALL getpar('guide_invertp',.true.,invert_p,'niveaux p inverses')
-    CALL getpar('guide_inverty',.true.,invert_y,'inversion N-S')
-    CALL getpar('guide_2D',.false.,guide_2D,'fichier guidage lat-P')
-
-! ---------------------------------------------
-! Determination du nombre de niveaux verticaux
-! des fichiers guidage
-! ---------------------------------------------
-    ncidpl=-99
-    if (guide_modele) then
-       if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
-    else
-         if (guide_u) then
-           if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
-         elseif (guide_v) then
-           if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
-         elseif (guide_T) then
-           if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
-         elseif (guide_Q) then
-           if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
-         endif
-    endif 
-    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
-    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
-    IF (error.NE.NF_NOERR) THEN
-        print *,'Guide: probleme lecture niveaux pression'
-        CALL abort_gcm(modname,abort_message,1)
-    ENDIF
-    error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
-    print *,'Guide: nombre niveaux vert. nlevnc', nlevnc 
-    rcod = nf90_close(ncidpl)
-
-! ---------------------------------------------
-! Allocation des variables
-! ---------------------------------------------
-    abort_message='pb in allocation guide'
-
-    ALLOCATE(apnc(nlevnc), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    ALLOCATE(bpnc(nlevnc), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    apnc=0.;bpnc=0.
-
-    ALLOCATE(alpha_pcor(llm), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    ALLOCATE(alpha_u(ip1jmp1), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    ALLOCATE(alpha_v(ip1jm), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    ALLOCATE(alpha_T(ip1jmp1), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    ALLOCATE(alpha_Q(ip1jmp1), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    ALLOCATE(alpha_P(ip1jmp1), stat = error)
-    IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-    alpha_u=0.;alpha_v=0;alpha_T=0;alpha_Q=0;alpha_P=0
-    
-    IF (guide_u) THEN
-        ALLOCATE(unat1(iip1,jjp1,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(ugui1(ip1jmp1,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(unat2(iip1,jjp1,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(ugui2(ip1jmp1,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        unat1=0.;unat2=0.;ugui1=0.;ugui2=0.
-    ENDIF
-
-    IF (guide_T) THEN
-        ALLOCATE(tnat1(iip1,jjp1,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tgui1(ip1jmp1,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tnat2(iip1,jjp1,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(tgui2(ip1jmp1,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        tnat1=0.;tnat2=0.;tgui1=0.;tgui2=0.
-    ENDIF
-     
-    IF (guide_Q) THEN
-        ALLOCATE(qnat1(iip1,jjp1,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qgui1(ip1jmp1,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qnat2(iip1,jjp1,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(qgui2(ip1jmp1,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        qnat1=0.;qnat2=0.;qgui1=0.;qgui2=0.
-    ENDIF
-
-    IF (guide_v) THEN
-        ALLOCATE(vnat1(iip1,jjm,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vgui1(ip1jm,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vnat2(iip1,jjm,nlevnc), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(vgui2(ip1jm,llm), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        vnat1=0.;vnat2=0.;vgui1=0.;vgui2=0.
-    ENDIF
-
-    IF (guide_P.OR.guide_modele) THEN
-        ALLOCATE(psnat1(iip1,jjp1), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(psnat2(iip1,jjp1), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        psnat1=0.;psnat2=0.;
-    ENDIF
-    IF (guide_P) THEN
-        ALLOCATE(psgui2(ip1jmp1), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        ALLOCATE(psgui1(ip1jmp1), stat = error)
-        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
-        psgui1=0.;psgui2=0.
-    ENDIF
-
-! ---------------------------------------------
-!   Lecture du premier etat de guidage.
-! ---------------------------------------------
-    IF (guide_2D) THEN
-        CALL guide_read2D(1)
-    ELSE
-        CALL guide_read(1)
-    ENDIF
-    IF (guide_v) vnat1=vnat2
-    IF (guide_u) unat1=unat2
-    IF (guide_T) tnat1=tnat2
-    IF (guide_Q) qnat1=qnat2
-    IF (guide_P.OR.guide_modele) psnat1=psnat2
-
-  END SUBROUTINE guide_init
-
-!=======================================================================
-  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
-    use parallel
-    USE control_mod
-    
-    IMPLICIT NONE
-  
-    INCLUDE "dimensions.h"
-    INCLUDE "paramet.h"
-    INCLUDE "comconst.h"
-    INCLUDE "comvert.h"
-
-    ! Variables entree
-    INTEGER,                       INTENT(IN)    :: itau !pas de temps
-    REAL, DIMENSION (ip1jmp1,llm), INTENT(INOUT) :: ucov,teta,q,masse
-    REAL, DIMENSION (ip1jm,llm),   INTENT(INOUT) :: vcov
-    REAL, DIMENSION (ip1jmp1),     INTENT(INOUT) :: ps
-
-    ! Variables locales
-    LOGICAL, SAVE :: first=.TRUE.
-    LOGICAL       :: f_out ! sortie guidage
-    REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage
-    REAL, DIMENSION (ip1jmp1,llm) :: p ! besoin si guide_P
-    ! Compteurs temps:
-    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
-    REAL          :: ditau, dday_step
-    REAL          :: tau,reste ! position entre 2 etats de guidage
-    REAL, SAVE    :: factt ! pas de temps en fraction de jour
-    
-    INTEGER       :: l
-    
-    ijb_u=ij_begin ; ije_u=ij_end ; ijn_u=ije_u-ijb_u+1  
-    jjb_u=jj_begin ; jje_u=jj_end ; jjn_u=jje_u-jjb_u+1 
-    ijb_v=ij_begin ; ije_v=ij_end ; ijn_v=ije_v-ijb_v+1   
-    jjb_v=jj_begin ; jje_v=jj_end ; jjn_v=jje_v-jjb_v+1 
-    IF (pole_sud) THEN
-      ije_v=ij_end-iip1
-      jje_v=jj_end-1
-      ijn_v=ije_v-ijb_v+1
-      jjn_v=jje_v-jjb_v+1 
-    ENDIF
-      
-    
-    
-     PRINT *,'---> on rentre dans guide_main'
-!    CALL AllGather_Field(ucov,ip1jmp1,llm)
-!    CALL AllGather_Field(vcov,ip1jm,llm)
-!    CALL AllGather_Field(teta,ip1jmp1,llm)
-!    CALL AllGather_Field(ps,ip1jmp1,1)
-!    CALL AllGather_Field(q,ip1jmp1,llm)
-    
-!-----------------------------------------------------------------------
-! Initialisations au premier passage
-!-----------------------------------------------------------------------
-
-    IF (first) THEN
-        first=.FALSE.
-        CALL guide_init 
-        itau_test=1001
-        step_rea=1
-        count_no_rea=0
-! Calcul des constantes de rappel
-        factt=dtvr*iperiod/daysec 
-        call tau2alpha(3,iip1,jjm ,factt,tau_min_v,tau_max_v,alpha_v)
-        call tau2alpha(2,iip1,jjp1,factt,tau_min_u,tau_max_u,alpha_u)
-        call tau2alpha(1,iip1,jjp1,factt,tau_min_T,tau_max_T,alpha_T)
-        call tau2alpha(1,iip1,jjp1,factt,tau_min_P,tau_max_P,alpha_P)
-        call tau2alpha(1,iip1,jjp1,factt,tau_min_Q,tau_max_Q,alpha_Q)
-! correction de rappel dans couche limite
-        if (guide_BL) then
-             alpha_pcor(:)=1.
-        else
-            do l=1,llm
-                alpha_pcor(l)=(1.+tanh((0.85-presnivs(l)/preff)/0.05))/2.
-            enddo
-        endif
-! ini_anal: etat initial egal au guidage        
-        IF (ini_anal) THEN
-            CALL guide_interp(ps,teta)
-            IF (guide_u) ucov(ijb_u:ije_u,:)=ugui2(ijb_u:ije_u,:)
-            IF (guide_v) vcov(ijb_v:ije_v,:)=ugui2(ijb_v:ije_v,:)
-            IF (guide_T) teta(ijb_u:ije_u,:)=tgui2(ijb_u:ije_u,:)
-            IF (guide_Q) q(ijb_u:ije_u,:)=qgui2(ijb_u:ije_u,:)
-            IF (guide_P) THEN
-                ps(ijb_u:ije_u)=psgui2(ijb_u:ije_u)
-                CALL pression_p(ip1jmp1,ap,bp,ps,p)
-                CALL massdair_p(p,masse)
-            ENDIF
-            RETURN
-        ENDIF
-! Verification structure guidage
-        IF (guide_u) THEN
-            CALL writefield_p('unat',unat1)
-            CALL writefield_p('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))
-        ENDIF
-        IF (guide_T) THEN
-            CALL writefield_p('tnat',tnat1)
-            CALL writefield_p('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))
-        ENDIF
-
-    ENDIF !first
-
-!-----------------------------------------------------------------------
-! Lecture des fichiers de guidage ?
-!-----------------------------------------------------------------------
-    IF (iguide_read.NE.0) THEN
-      ditau=real(itau)
-      dday_step=real(day_step)
-      IF (iguide_read.LT.0) THEN
-          tau=ditau/dday_step/ REAL(iguide_read)
-      ELSE
-          tau= REAL(iguide_read)*ditau/dday_step
-      ENDIF
-      reste=tau-AINT(tau)
-      IF (reste.EQ.0.) THEN
-          IF (itau_test.EQ.itau) THEN
-              write(*,*)'deuxieme passage de advreel a itau=',itau
-              stop
-          ELSE
-              IF (guide_v) vnat1(:,jjb_v:jje_v,:)=vnat2(:,jjb_v:jje_v,:)
-              IF (guide_u) unat1(:,jjb_u:jje_u,:)=unat2(:,jjb_u:jje_u,:)
-              IF (guide_T) tnat1(:,jjb_u:jje_u,:)=tnat2(:,jjb_u:jje_u,:)
-              IF (guide_Q) qnat1(:,jjb_u:jje_u,:)=qnat2(:,jjb_u:jje_u,:)
-              IF (guide_P.OR.guide_modele) psnat1(:,jjb_u:jje_u)=psnat2(:,jjb_u:jje_u)
-              step_rea=step_rea+1
-              itau_test=itau
-              print*,'Lecture fichiers guidage, pas ',step_rea, &
-                    'apres ',count_no_rea,' non lectures'
-              IF (guide_2D) THEN
-                  CALL guide_read2D(step_rea)
-              ELSE
-                  CALL guide_read(step_rea)
-              ENDIF
-              count_no_rea=0
-          ENDIF
-      ELSE
-        count_no_rea=count_no_rea+1
-
-      ENDIF
-    ENDIF !iguide_read=0
-
-!-----------------------------------------------------------------------
-! Interpolation et conversion des champs de guidage
-!-----------------------------------------------------------------------
-    IF (MOD(itau,iguide_int).EQ.0) THEN
-        CALL guide_interp(ps,teta)
-    ENDIF
-! Repartition entre 2 etats de guidage
-    IF (iguide_read.NE.0) THEN
-        tau=reste
-    ELSE
-        tau=1.
-    ENDIF
-
-!-----------------------------------------------------------------------
-!   Ajout des champs de guidage 
-!-----------------------------------------------------------------------
-! Sauvegarde du guidage?
-    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav)  
-    IF (f_out) CALL guide_out("S",jjp1,1,ps)
-    
-    if (guide_u) then
-        if (guide_add) then
-           f_add(ijb_u:ije_u,:)=(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:)
-        else
-           f_add(ijb_u:ije_u,:)=(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:)-ucov(ijb_u:ije_u,:)
-        endif 
-
-        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
-        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
-        IF (f_out) CALL guide_out("U",jjp1,llm,f_add/factt)
-        ucov(ijb_u:ije_u,:)=ucov(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
-    endif
-
-    if (guide_T) then
-        if (guide_add) then
-           f_add(ijb_u:ije_u,:)=(1.-tau)*tgui1(ijb_u:ije_u,:)+tau*tgui2(ijb_u:ije_u,:)
-        else
-           f_add(ijb_u:ije_u,:)=(1.-tau)*tgui1(ijb_u:ije_u,:)+tau*tgui2(ijb_u:ije_u,:)-teta(ijb_u:ije_u,:)
-        endif 
-        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
-        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
-        IF (f_out) CALL guide_out("T",jjp1,llm,f_add/factt)
-        teta(ijb_u:ije_u,:)=teta(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
-    endif
-
-    if (guide_P) then
-        if (guide_add) then
-           f_add(ijb_u:ije_u,1)=(1.-tau)*psgui1(ijb_u:ije_u)+tau*psgui2(ijb_u:ije_u)
-        else
-           f_add(ijb_u:ije_u,1)=(1.-tau)*psgui1(ijb_u:ije_u)+tau*psgui2(ijb_u:ije_u)-ps(ijb_u:ije_u)
-        endif 
-        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
-        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
-        IF (f_out) CALL guide_out("P",jjp1,1,f_add(1:ip1jmp1,1)/factt)
-        ps(ijb_u:ije_u)=ps(ijb_u:ije_u)+f_add(ijb_u:ije_u,1)
-        CALL pression_p(ip1jmp1,ap,bp,ps,p)
-        CALL massdair_p(p,masse)
-    endif
-
-    if (guide_Q) then
-        if (guide_add) then
-           f_add(ijb_u:ije_u,:)=(1.-tau)*qgui1(ijb_u:ije_u,:)+tau*qgui2(ijb_u:ije_u,:)
-        else
-           f_add(ijb_u:ije_u,:)=(1.-tau)*qgui1(ijb_u:ije_u,:)+tau*qgui2(ijb_u:ije_u,:)-q(ijb_u:ije_u,:)
-        endif 
-        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
-        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
-        IF (f_out) CALL guide_out("Q",jjp1,llm,f_add/factt)
-        q(ijb_u:ije_u,:)=q(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
-    endif
-
-    if (guide_v) then
-        if (guide_add) then
-           f_add(ijb_v:ije_v,:)=(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:)
-        else
-           f_add(ijb_v:ije_v,:)=(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:)-vcov(ijb_v:ije_v,:)
-        endif 
-        
-        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
-        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
-        IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:)/factt)
-        vcov(ijb_v:ije_v,:)=vcov(ijb_v:ije_v,:)+f_add(ijb_v:ije_v,:)
-    endif
-
-  END SUBROUTINE guide_main
-
-!=======================================================================
-  SUBROUTINE guide_addfield(hsize,vsize,field,alpha)
-! field1=a*field1+alpha*field2
-
-    IMPLICIT NONE
-    INCLUDE "dimensions.h"
-    INCLUDE "paramet.h"
-
-    ! input variables
-    INTEGER,                      INTENT(IN)    :: hsize
-    INTEGER,                      INTENT(IN)    :: vsize
-    REAL, DIMENSION(hsize),       INTENT(IN)    :: alpha 
-    REAL, DIMENSION(hsize,vsize), INTENT(INOUT) :: field
-
-    ! Local variables
-    INTEGER :: l
-
-    IF (hsize==ip1jm) THEN
-      do l=1,vsize
-        field(ijb_v:ije_v,l)=alpha(ijb_v:ije_v)*field(ijb_v:ije_v,l)*alpha_pcor(l)
-      enddo
-    ELSE
-      do l=1,vsize
-        field(ijb_u:ije_u,l)=alpha(ijb_u:ije_u)*field(ijb_u:ije_u,l)*alpha_pcor(l)
-      enddo
-    ENDIF    
-
-  END SUBROUTINE guide_addfield
-
-!=======================================================================
-  SUBROUTINE guide_zonave(typ,hsize,vsize,field)
-
-    IMPLICIT NONE
-
-    INCLUDE "dimensions.h"
-    INCLUDE "paramet.h"
-    INCLUDE "comgeom.h"
-    INCLUDE "comconst.h"
-    
-    ! input/output variables
-    INTEGER,                           INTENT(IN)    :: typ
-    INTEGER,                           INTENT(IN)    :: vsize
-    INTEGER,                           INTENT(IN)    :: hsize
-    REAL, DIMENSION(hsize*iip1,vsize), INTENT(INOUT) :: field
-
-    ! Local variables
-    LOGICAL, SAVE                :: first=.TRUE.
-    INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
-    INTEGER                      :: i,j,l,ij
-    REAL, DIMENSION (iip1)       :: lond       ! longitude in Deg.
-    REAL, DIMENSION (hsize,vsize):: fieldm     ! zon-averaged field
-
-    IF (first) THEN
-        first=.FALSE.
-!Compute domain for averaging
-        lond=rlonu*180./pi
-        imin(1)=1;imax(1)=iip1;
-        imin(2)=1;imax(2)=iip1;
-        IF (guide_reg) THEN
-            DO i=1,iim
-                IF (lond(i).LT.lon_min_g) imin(1)=i
-                IF (lond(i).LE.lon_max_g) imax(1)=i
-            ENDDO
-            lond=rlonv*180./pi
-            DO i=1,iim
-                IF (lond(i).LT.lon_min_g) imin(2)=i
-                IF (lond(i).LE.lon_max_g) imax(2)=i
-            ENDDO
-        ENDIF
-    ENDIF
-
-    fieldm=0.
-    
-    IF (hsize==jjm) THEN
-      DO l=1,vsize
-      ! Compute zonal average
-          DO j=jjb_v,jje_v
-              DO i=imin(typ),imax(typ)
-                  ij=(j-1)*iip1+i
-                  fieldm(j,l)=fieldm(j,l)+field(ij,l)
-              ENDDO
-          ENDDO 
-          fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1)
-    ! Compute forcing
-          DO j=jjb_v,jje_v
-              DO i=1,iip1
-                  ij=(j-1)*iip1+i
-                  field(ij,l)=fieldm(j,l)
-              ENDDO
-          ENDDO
-      ENDDO
-    ELSE
-      DO l=1,vsize
-      ! Compute zonal average
-          DO j=jjb_v,jje_v
-              DO i=imin(typ),imax(typ)
-                  ij=(j-1)*iip1+i
-                  fieldm(j,l)=fieldm(j,l)+field(ij,l)
-              ENDDO
-          ENDDO 
-          fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1)
-    ! Compute forcing
-          DO j=jjb_u,jje_u
-              DO i=1,iip1
-                  ij=(j-1)*iip1+i
-                  field(ij,l)=fieldm(j,l)
-              ENDDO
-          ENDDO
-      ENDDO
-    ENDIF    
-
-  END SUBROUTINE guide_zonave
-
-!=======================================================================
-  SUBROUTINE guide_interp(psi,teta)
-  USE parallel
-  USE mod_hallo
-  USE Bands
-  IMPLICIT NONE
-
-  include "dimensions.h"
-  include "paramet.h"
-  include "comvert.h"
-  include "comgeom2.h"
-  include "comconst.h"
-
-  REAL, DIMENSION (iip1,jjp1),     INTENT(IN) :: psi ! Psol gcm
-  REAL, DIMENSION (iip1,jjp1,llm), INTENT(IN) :: teta ! Temp. Pot. gcm
-
-  LOGICAL, SAVE                      :: first=.TRUE.
-  ! Variables pour niveaux pression:
-  REAL, DIMENSION (iip1,jjp1,nlevnc) :: plnc1,plnc2 !niveaux pression guidage
-  REAL, DIMENSION (iip1,jjp1,llm)    :: plunc,plsnc !niveaux pression modele
-  REAL, DIMENSION (iip1,jjm,llm)     :: plvnc       !niveaux pression modele
-!ym rustine temporaire pour ne pas depasser 2GB pour la stack
-!ym  => crach compilo avec la version intel 12
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE  :: p           ! pression intercouches 
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE    :: pls, pext   ! var intermediaire
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE    :: pbarx 
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE     :: pbary 
-  ! Variables pour fonction Exner (P milieu couche)
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE    :: pk, pkf
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE    :: alpha, beta
-  REAL, DIMENSION (:,:),ALLOCATABLE,SAVE        :: pks    
-  REAL                               :: prefkap,unskap
-  ! Pression de vapeur saturante
-  REAL, DIMENSION (ip1jmp1,llm)      :: qsat
-  !Variables intermediaires interpolation
-
-!ym rustine temporaire pour ne pas depasser 2GB pour la stack
-!ym  => crach compilo avec la version intel 12
-!  REAL, DIMENSION (iip1,jjp1,llm)    :: zu1,zu2 
-!  REAL, DIMENSION (iip1,jjm,llm)     :: zv1,zv2
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE     :: zu1,zu2 
-  REAL, DIMENSION (:,:,:),ALLOCATABLE,SAVE     :: zv1,zv2
-  
-  INTEGER                            :: i,j,l,ij
-  TYPE(Request) :: Req  
-
-    print *,'Guide: conversion variables guidage'
-! -----------------------------------------------------------------
-! Calcul des niveaux de pression champs guidage
-! -----------------------------------------------------------------
-if (guide_modele) then
-    do i=1,iip1
-        do j=jjb_u,jje_u
-            do l=1,nlevnc
-                plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
-                plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
-            enddo
-        enddo
-    enddo
-else
-    do i=1,iip1
-        do j=jjb_u,jje_u
-            do l=1,nlevnc
-                plnc2(i,j,l)=apnc(l)
-                plnc1(i,j,l)=apnc(l)
-           enddo
-        enddo
-    enddo
-
-endif
-    if (first) then
-        first=.FALSE.
-        print*,'Guide: verification ordre niveaux verticaux'
-        print*,'LMDZ :'
-        do l=1,llm
-            print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
-                  +psi(1,jje_u)*(bp(l)+bp(l+1))/2.
-        enddo
-        print*,'Fichiers guidage'
-        do l=1,nlevnc
-             print*,'PL(',l,')=',plnc2(1,jjb_u,l)
-        enddo
-        print *,'inversion de l''ordre: invert_p=',invert_p
-        if (guide_u) then
-            do l=1,nlevnc
-                print*,'U(',l,')=',unat2(1,jjb_u,l)
-            enddo
-        endif
-        if (guide_T) then
-            do l=1,nlevnc
-                print*,'T(',l,')=',tnat2(1,jjb_u,l)
-            enddo
-        endif
-        ALLOCATE( zu1(iip1,jjp1,llm),zu2(iip1,jjp1,llm)) 
-        ALLOCATE( zv1(iip1,jjm,llm),zv2(iip1,jjm,llm)) 
-        ALLOCATE( p(iip1,jjp1,llmp1) )
-        ALLOCATE( pls(iip1,jjp1,llm), pext(iip1,jjp1,llm) )
-        ALLOCATE( pbarx(iip1,jjp1,llm) )
-        ALLOCATE( pbary(iip1,jjm,llm) )
-        ALLOCATE( pk(iip1,jjp1,llm),pkf(iip1,jjp1,llm) )
-        ALLOCATE( alpha(iip1,jjp1,llm),beta(iip1,jjp1,llm) )
-        ALLOCATE( pks(iip1,jjp1) )
-      endif
-    
-! -----------------------------------------------------------------
-! Calcul niveaux pression modele 
-! -----------------------------------------------------------------
-    CALL pression_p( ip1jmp1, ap, bp, psi, p )
-    CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
-
-!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
-    unskap=1./kappa
-    prefkap =  preff  ** kappa
-    DO l = 1, llm
-        DO j=jjb_u,jje_u
-            DO i =1, iip1
-                pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
-            ENDDO
-        ENDDO
-    ENDDO
-
-!   calcul des pressions pour les grilles u et v
-    do l=1,llm
-        do j=jjb_u,jje_u
-            do i=1,iip1
-                pext(i,j,l)=pls(i,j,l)*aire(i,j)
-            enddo
-        enddo
-    enddo
-
-     CALL Register_SwapFieldHallo(pext,pext,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
-     CALL SendRequest(Req)
-     CALL WaitRequest(Req)
-
-     call massbar_p(pext, pbarx, pbary )
-    do l=1,llm
-        do j=jjb_u,jje_u
-            do i=1,iip1
-                plunc(i,j,l)=pbarx(i,j,l)/aireu(i,j)
-                plsnc(i,j,l)=pls(i,j,l)
-            enddo
-        enddo
-    enddo
-    do l=1,llm
-        do j=jjb_v,jje_v
-            do i=1,iip1
-                plvnc(i,j,l)=pbary(i,j,l)/airev(i,j)
-            enddo
-        enddo
-    enddo
-
-! -----------------------------------------------------------------
-! Interpolation champs guidage sur niveaux modele (+inversion N/S)
-! Conversion en variables gcm (ucov, vcov...)
-! -----------------------------------------------------------------
-    if (guide_P) then
-        do j=jjb_u,jje_u
-            do i=1,iim
-                ij=(j-1)*iip1+i
-                psgui1(ij)=psnat1(i,j)
-                psgui2(ij)=psnat2(i,j)
-            enddo
-            psgui1(iip1*j)=psnat1(1,j)
-            psgui2(iip1*j)=psnat2(1,j)
-        enddo
-    endif
-
-    IF (guide_u) THEN
-        CALL pres2lev(unat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,            &
-                      plnc1(:,jjb_u:jje_u,:),plunc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
-        CALL pres2lev(unat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,            &
-                      plnc2(:,jjb_u:jje_u,:),plunc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
-
-        do l=1,llm
-            do j=jjb_u,jje_u
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    ugui1(ij,l)=zu1(i,j,l)*cu(i,j)
-                    ugui2(ij,l)=zu2(i,j,l)*cu(i,j)
-                enddo
-                ugui1(j*iip1,l)=ugui1((j-1)*iip1+1,l)    
-                ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l)    
-            enddo
-            do i=1,iip1
-                ugui1(i,l)=0.
-                ugui1(ip1jm+i,l)=0.
-                ugui2(i,l)=0.
-                ugui2(ip1jm+i,l)=0.
-            enddo
-        enddo
-    ENDIF
-    
-    IF (guide_T) THEN
-        CALL pres2lev(tnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,           &
-                      plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
-        CALL pres2lev(tnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,           &
-                      plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
-
-        do l=1,llm
-            do j=jjb_u,jje_u
-                IF (guide_teta) THEN
-		    do i=1,iim
-			ij=(j-1)*iip1+i
-			tgui1(ij,l)=zu1(i,j,l)
-			tgui2(ij,l)=zu2(i,j,l)
-		    enddo
-                ELSE
-		    do i=1,iim
-			ij=(j-1)*iip1+i
-			tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
-			tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
-		    enddo
-                ENDIF
-                tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l)    
-                tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l)    
-            enddo
-            do i=1,iip1
-                tgui1(i,l)=tgui1(1,l)
-                tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) 
-                tgui2(i,l)=tgui2(1,l)
-                tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l) 
-            enddo
-        enddo
-    ENDIF
-
-    IF (guide_v) THEN
-        
-        CALL pres2lev(vnat1(:,jjb_v:jje_v,:),zv1(:,jjb_v:jje_v,:),nlevnc,llm,             &
-                      plnc1(:,jjb_v:jje_v,:),plvnc(:,jjb_v:jje_v,:),iip1,jjn_v,invert_p)
-        CALL pres2lev(vnat2(:,jjb_v:jje_v,:),zv2(:,jjb_v:jje_v,:),nlevnc,llm,             &
-                      plnc2(:,jjb_v:jje_v,:),plvnc(:,jjb_v:jje_v,:),iip1,jjn_v,invert_p)
-
-        do l=1,llm
-            do j=jjb_v,jje_v
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    vgui1(ij,l)=zv1(i,j,l)*cv(i,j)
-                    vgui2(ij,l)=zv2(i,j,l)*cv(i,j)
-                enddo
-                vgui1(j*iip1,l)=vgui1((j-1)*iip1+1,l)    
-                vgui2(j*iip1,l)=vgui2((j-1)*iip1+1,l)    
-            enddo
-        enddo
-    ENDIF
-    
-    IF (guide_Q) THEN
-        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
-        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
-        CALL pres2lev(qnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,             &
-                      plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
-        CALL pres2lev(qnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,             &
-                      plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
-
-        do l=1,llm
-            do j=jjb_u,jjb_v
-                do i=1,iim
-                    ij=(j-1)*iip1+i
-                    qgui1(ij,l)=zu1(i,j,l)
-                    qgui2(ij,l)=zu2(i,j,l)
-                enddo
-                qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l)    
-                qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l)    
-            enddo
-            do i=1,iip1
-                qgui1(i,l)=qgui1(1,l)
-                qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) 
-                qgui2(i,l)=qgui2(1,l)
-                qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l) 
-            enddo
-        enddo
-        IF (guide_hr) THEN
-            CALL q_sat(iip1*jjn_u*llm,teta(:,jjb_u:jje_u,:)*pk(:,jjb_u:jje_u,:)/cpp,       &
-                       plsnc(:,jjb_u:jje_u,:),qsat(ijb_u:ije_u,:))
-            qgui1(ijb_u:ije_u,:)=qgui1(ijb_u:ije_u,:)*qsat(ijb_u:ije_u,:)*0.01 !hum. rel. en %
-            qgui2(ijb_u:ije_u,:)=qgui2(ijb_u:ije_u,:)*qsat(ijb_u:ije_u,:)*0.01 
-        ENDIF
-    ENDIF
-
-  END SUBROUTINE guide_interp
-
-!=======================================================================
-  SUBROUTINE tau2alpha(typ,pim,pjm,factt,taumin,taumax,alpha)
-
-! Calcul des constantes de rappel alpha (=1/tau)
-
-    implicit none
-
-    include "dimensions.h"
-    include "paramet.h"
-    include "comconst.h"
-    include "comgeom2.h"
-    include "serre.h"
-
-! input arguments :
-    INTEGER, INTENT(IN) :: typ    ! u(2),v(3), ou scalaire(1)
-    INTEGER, INTENT(IN) :: pim,pjm ! dimensions en lat, lon
-    REAL, INTENT(IN)    :: factt   ! pas de temps en fraction de jour
-    REAL, INTENT(IN)    :: taumin,taumax
-! output arguments:
-    REAL, DIMENSION(pim,pjm), INTENT(OUT) :: alpha 
-  
-!  local variables:
-    LOGICAL, SAVE               :: first=.TRUE.
-    REAL, SAVE                  :: gamma,dxdy_min,dxdy_max
-    REAL, DIMENSION (iip1,jjp1) :: zdx,zdy
-    REAL, DIMENSION (iip1,jjp1) :: dxdys,dxdyu
-    REAL, DIMENSION (iip1,jjm)  :: dxdyv
-    real dxdy_
-    real zlat,zlon
-    real alphamin,alphamax,xi
-    integer i,j,ilon,ilat
-
-
-    alphamin=factt/taumax
-    alphamax=factt/taumin
-    IF (guide_reg.OR.guide_add) THEN
-        alpha=alphamax
-!-----------------------------------------------------------------------
-! guide_reg: alpha=alpha_min dans region, 0. sinon.
-!-----------------------------------------------------------------------
-        IF (guide_reg) THEN
-            do j=1,pjm
-                do i=1,pim
-                    if (typ.eq.2) then
-                       zlat=rlatu(j)*180./pi
-                       zlon=rlonu(i)*180./pi
-                    elseif (typ.eq.1) then
-                       zlat=rlatu(j)*180./pi
-                       zlon=rlonv(i)*180./pi
-                    elseif (typ.eq.3) then
-                       zlat=rlatv(j)*180./pi
-                       zlon=rlonv(i)*180./pi
-                    endif
-                    alpha(i,j)=alphamax/16.* &
-                              (1.+tanh((zlat-lat_min_g)/tau_lat))* &
-                              (1.+tanh((lat_max_g-zlat)/tau_lat))* &
-                              (1.+tanh((zlon-lon_min_g)/tau_lon))* &
-                              (1.+tanh((lon_max_g-zlon)/tau_lon))
-                enddo
-            enddo
-        ENDIF
-    ELSE
-!-----------------------------------------------------------------------
-! Sinon, alpha varie entre alpha_min et alpha_max suivant le zoom.
-!-----------------------------------------------------------------------
-!Calcul de l'aire des mailles
-        do j=2,jjm
-            do i=2,iip1
-               zdx(i,j)=0.5*(cu(i-1,j)+cu(i,j))/cos(rlatu(j))
-            enddo
-            zdx(1,j)=zdx(iip1,j)
-        enddo
-        do j=2,jjm
-            do i=1,iip1
-               zdy(i,j)=0.5*(cv(i,j-1)+cv(i,j))
-            enddo
-        enddo
-        do i=1,iip1
-            zdx(i,1)=zdx(i,2)
-            zdx(i,jjp1)=zdx(i,jjm)
-            zdy(i,1)=zdy(i,2)
-            zdy(i,jjp1)=zdy(i,jjm)
-        enddo
-        do j=1,jjp1
-            do i=1,iip1
-               dxdys(i,j)=sqrt(zdx(i,j)*zdx(i,j)+zdy(i,j)*zdy(i,j))
-            enddo
-        enddo
-        IF (typ.EQ.2) THEN
-            do j=1,jjp1
-                do i=1,iim
-                   dxdyu(i,j)=0.5*(dxdys(i,j)+dxdys(i+1,j))
-                enddo
-                dxdyu(iip1,j)=dxdyu(1,j)
-            enddo
-        ENDIF
-        IF (typ.EQ.3) THEN
-            do j=1,jjm
-                do i=1,iip1
-                   dxdyv(i,j)=0.5*(dxdys(i,j)+dxdys(i,j+1))
-                enddo
-            enddo
-        ENDIF
-! Premier appel: calcul des aires min et max et de gamma.
-        IF (first) THEN 
-            first=.FALSE.
-            ! coordonnees du centre du zoom
-            CALL coordij(clon,clat,ilon,ilat) 
-            ! aire de la maille au centre du zoom
-            dxdy_min=dxdys(ilon,ilat)
-            ! dxdy maximale de la maille
-            dxdy_max=0.
-            do j=1,jjp1
-                do i=1,iip1
-                     dxdy_max=max(dxdy_max,dxdys(i,j))
-                enddo
-            enddo
-            ! Calcul de gamma
-            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
-                 print*,'ATTENTION modele peu zoome'
-                 print*,'ATTENTION on prend une constante de guidage cste'
-                 gamma=0.
-            else
-                gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
-                print*,'gamma=',gamma
-                if (gamma.lt.1.e-5) then
-                  print*,'gamma =',gamma,'<1e-5'
-                  stop
-                endif
-                gamma=log(0.5)/log(gamma)
-                if (gamma4) then 
-                  gamma=min(gamma,4.)
-                endif
-                print*,'gamma=',gamma
-            endif
-        ENDIF !first
-
-        do j=1,pjm
-            do i=1,pim
-                if (typ.eq.1) then
-                   dxdy_=dxdys(i,j)
-                   zlat=rlatu(j)*180./pi
-                elseif (typ.eq.2) then
-                   dxdy_=dxdyu(i,j)
-                   zlat=rlatu(j)*180./pi
-                elseif (typ.eq.3) then
-                   dxdy_=dxdyv(i,j)
-                   zlat=rlatv(j)*180./pi
-                endif
-                if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
-                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
-                    alpha(i,j)=alphamin
-                else
-                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
-                    xi=min(xi,1.)
-                    if(lat_min_g.le.zlat .and. zlat.le.lat_max_g) then
-                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
-                    else
-                        alpha(i,j)=0.
-                    endif
-                endif
-            enddo
-        enddo
-    ENDIF ! guide_reg
-
-  END SUBROUTINE tau2alpha
-
-!=======================================================================
-  SUBROUTINE guide_read(timestep)
-
-    IMPLICIT NONE
-
-#include "netcdf.inc"
-#include "dimensions.h"
-#include "paramet.h"
-
-    INTEGER, INTENT(IN)   :: timestep
-
-    LOGICAL, SAVE         :: first=.TRUE.
-! Identification fichiers et variables NetCDF:
-    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
-    INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
-    INTEGER               :: ncidpl,varidpl,varidap,varidbp
-! Variables auxiliaires NetCDF:
-    INTEGER, DIMENSION(4) :: start,count
-    INTEGER               :: status,rcode
-
-! -----------------------------------------------------------------
-! Premier appel: initialisation de la lecture des fichiers
-! -----------------------------------------------------------------
-    if (first) then
-         ncidpl=-99
-         print*,'Guide: ouverture des fichiers guidage '
-! Niveaux de pression si non constants
-         if (guide_modele) then
-             print *,'Lecture du guidage sur niveaux mod�le'
-             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
-             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
-             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
-             print*,'ncidpl,varidap',ncidpl,varidap
-         endif
-! Vent zonal
-         if (guide_u) then
-             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
-             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
-             print*,'ncidu,varidu',ncidu,varidu
-             if (ncidpl.eq.-99) ncidpl=ncidu
-         endif
-! Vent meridien
-         if (guide_v) then
-             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
-             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
-             print*,'ncidv,varidv',ncidv,varidv
-             if (ncidpl.eq.-99) ncidpl=ncidv
-         endif
-! Temperature
-         if (guide_T) then
-             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
-             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
-             print*,'ncidT,varidT',ncidt,varidt
-             if (ncidpl.eq.-99) ncidpl=ncidt
-         endif
-! Humidite
-         if (guide_Q) then
-             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
-             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
-             print*,'ncidQ,varidQ',ncidQ,varidQ
-             if (ncidpl.eq.-99) ncidpl=ncidQ
-         endif
-! Pression de surface
-         if ((guide_P).OR.(guide_modele)) then
-             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
-             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
-             print*,'ncidps,varidps',ncidps,varidps
-         endif
-! Coordonnee verticale
-         if (.not.guide_modele) then
-              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
-              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
-              print*,'ncidpl,varidpl',ncidpl,varidpl
-         endif
-! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         if (guide_modele) then
-#ifdef NC_DOUBLE
-             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
-             status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc)
-#else
-             status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc)
-             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
-#endif
-         else
-#ifdef NC_DOUBLE
-             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
-#else
-             status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc)
-#endif
-             apnc=apnc*100.! conversion en Pascals
-             bpnc(:)=0.
-         endif
-         first=.FALSE.
-     endif ! (first)
-
-! -----------------------------------------------------------------
-!   lecture des champs u, v, T, Q, ps
-! -----------------------------------------------------------------
-
-!  dimensions pour les champs scalaires et le vent zonal
-     start(1)=1
-     start(2)=1
-     start(3)=1
-     start(4)=timestep
-
-     count(1)=iip1
-     count(2)=jjp1
-     count(3)=nlevnc
-     count(4)=1
-
-!  Vent zonal
-     if (guide_u) then
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unat2)
-#else
-         status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unat2)
-#endif
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,nlevnc,unat2)
-         ENDIF
-
-     endif
-
-!  Temperature
-     if (guide_T) then
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnat2)
-#else
-         status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnat2)
-#endif
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
-         ENDIF
-     endif
-
-!  Humidite
-     if (guide_Q) then
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,qnat2)
-#else
-         status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,qnat2)
-#endif
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
-         ENDIF
-
-     endif
-
-!  Vent meridien
-     if (guide_v) then
-         count(2)=jjm
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnat2)
-#else
-         status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnat2)
-#endif
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjm,nlevnc,vnat2)
-         ENDIF
-     endif
-
-!  Pression de surface
-     if ((guide_P).OR.(guide_modele))  then
-         start(3)=timestep
-         start(4)=0
-         count(2)=jjp1
-         count(3)=1
-         count(4)=0
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnat2)
-#else
-         status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnat2)
-#endif
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,1,psnat2)
-         ENDIF
-     endif
-
-  END SUBROUTINE guide_read
-
-!=======================================================================
-  SUBROUTINE guide_read2D(timestep)
-
-    IMPLICIT NONE
-
-#include "netcdf.inc"
-#include "dimensions.h"
-#include "paramet.h"
-
-    INTEGER, INTENT(IN)   :: timestep
-
-    LOGICAL, SAVE         :: first=.TRUE.
-! Identification fichiers et variables NetCDF:
-    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
-    INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
-    INTEGER               :: ncidpl,varidpl,varidap,varidbp
-! Variables auxiliaires NetCDF:
-    INTEGER, DIMENSION(4) :: start,count
-    INTEGER               :: status,rcode
-! Variables for 3D extension:
-    REAL, DIMENSION (jjp1,llm) :: zu
-    REAL, DIMENSION (jjm,llm)  :: zv
-    INTEGER               :: i
-
-! -----------------------------------------------------------------
-! Premier appel: initialisation de la lecture des fichiers
-! -----------------------------------------------------------------
-    if (first) then
-         ncidpl=-99
-         print*,'Guide: ouverture des fichiers guidage '
-! Niveaux de pression si non constants
-         if (guide_modele) then
-             print *,'Lecture du guidage sur niveaux mod�le'
-             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
-             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
-             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
-             print*,'ncidpl,varidap',ncidpl,varidap
-         endif
-! Vent zonal
-         if (guide_u) then
-             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
-             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
-             print*,'ncidu,varidu',ncidu,varidu
-             if (ncidpl.eq.-99) ncidpl=ncidu
-         endif
-! Vent meridien
-         if (guide_v) then
-             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
-             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
-             print*,'ncidv,varidv',ncidv,varidv
-             if (ncidpl.eq.-99) ncidpl=ncidv
-         endif
-! Temperature
-         if (guide_T) then
-             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
-             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
-             print*,'ncidT,varidT',ncidt,varidt
-             if (ncidpl.eq.-99) ncidpl=ncidt
-         endif
-! Humidite
-         if (guide_Q) then
-             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
-             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
-             print*,'ncidQ,varidQ',ncidQ,varidQ
-             if (ncidpl.eq.-99) ncidpl=ncidQ
-         endif
-! Pression de surface
-         if ((guide_P).OR.(guide_modele)) then
-             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
-             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
-             print*,'ncidps,varidps',ncidps,varidps
-         endif
-! Coordonnee verticale
-         if (.not.guide_modele) then
-              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
-              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
-              print*,'ncidpl,varidpl',ncidpl,varidpl
-         endif
-! Coefs ap, bp pour calcul de la pression aux differents niveaux
-         if (guide_modele) then
-#ifdef NC_DOUBLE
-             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
-             status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc)
-#else
-             status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc)
-             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
-#endif
-         else
-#ifdef NC_DOUBLE
-             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
-#else
-             status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc)
-#endif
-             apnc=apnc*100.! conversion en Pascals
-             bpnc(:)=0.
-         endif
-         first=.FALSE.
-     endif ! (first)
-
-! -----------------------------------------------------------------
-!   lecture des champs u, v, T, Q, ps
-! -----------------------------------------------------------------
-
-!  dimensions pour les champs scalaires et le vent zonal
-     start(1)=1
-     start(2)=1
-     start(3)=1
-     start(4)=timestep
-
-     count(1)=1
-     count(2)=jjp1
-     count(3)=nlevnc
-     count(4)=1
-
-!  Vent zonal
-     if (guide_u) then
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,zu)
-#else
-         status=NF_GET_VARA_REAL(ncidu,varidu,start,count,zu)
-#endif
-         DO i=1,iip1
-             unat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,nlevnc,unat2)
-         ENDIF
-
-     endif
-
-!  Temperature
-     if (guide_T) then
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,zu)
-#else
-         status=NF_GET_VARA_REAL(ncidt,varidt,start,count,zu)
-#endif
-         DO i=1,iip1
-             tnat2(i,:,:)=zu(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
-         ENDIF
-
-     endif
-
-!  Humidite
-     if (guide_Q) then
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,zu)
-#else
-         status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,zu)
-#endif
-         DO i=1,iip1
-             qnat2(i,:,:)=zu(:,:)
-         ENDDO
-         
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
-         ENDIF
-
-     endif
-
-!  Vent meridien
-     if (guide_v) then
-         count(2)=jjm
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,zv)
-#else
-         status=NF_GET_VARA_REAL(ncidv,varidv,start,count,zv)
-#endif
-         DO i=1,iip1
-             vnat2(i,:,:)=zv(:,:)
-         ENDDO
-
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjm,nlevnc,vnat2)
-         ENDIF
-
-     endif
-
-!  Pression de surface
-     if ((guide_P).OR.(guide_modele))  then
-         start(3)=timestep
-         start(4)=0
-         count(2)=jjp1
-         count(3)=1
-         count(4)=0
-#ifdef NC_DOUBLE
-         status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,zu(:,1))
-#else
-         status=NF_GET_VARA_REAL(ncidps,varidps,start,count,zu(:,1))
-#endif
-         DO i=1,iip1
-             psnat2(i,:)=zu(:,1)
-         ENDDO
-
-         IF (invert_y) THEN
-           CALL invert_lat(iip1,jjp1,1,psnat2)
-         ENDIF
-
-     endif
-
-  END SUBROUTINE guide_read2D
-  
-!=======================================================================
-  SUBROUTINE guide_out(varname,hsize,vsize,field)
-    USE parallel
-    IMPLICIT NONE
-
-    INCLUDE "dimensions.h"
-    INCLUDE "paramet.h"
-    INCLUDE "netcdf.inc"
-    INCLUDE "comgeom2.h"
-    INCLUDE "comconst.h"
-    INCLUDE "comvert.h"
-    
-    ! Variables entree
-    CHARACTER, INTENT(IN)                          :: varname
-    INTEGER,   INTENT (IN)                         :: hsize,vsize
-    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
-
-    ! Variables locales
-    INTEGER, SAVE :: timestep=0
-    ! Identites fichier netcdf
-    INTEGER       :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
-    INTEGER       :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
-    INTEGER, DIMENSION (3) :: dim3
-    INTEGER, DIMENSION (4) :: dim4,count,start
-    INTEGER                :: ierr, varid
-    
-    CALL gather_field(field,iip1*hsize,vsize,0)
-    
-    IF (mpi_rank /= 0) RETURN
-    
-    print *,'Guide: output timestep',timestep,'var ',varname
-    IF (timestep.EQ.0) THEN 
-! ----------------------------------------------
-! initialisation fichier de sortie
-! ----------------------------------------------
-! Ouverture du fichier
-        ierr=NF_CREATE("guide_ins.nc",NF_CLOBBER,nid)
-! Definition des dimensions
-        ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu) 
-        ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv) 
-        ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu) 
-        ierr=NF_DEF_DIM(nid,"LATV",jjm,id_latv) 
-        ierr=NF_DEF_DIM(nid,"LEVEL",llm,id_lev)
-        ierr=NF_DEF_DIM(nid,"TIME",NF_UNLIMITED,id_tim)
-
-! Creation des variables dimensions
-        ierr=NF_DEF_VAR(nid,"LONU",NF_FLOAT,1,id_lonu,vid_lonu)
-        ierr=NF_DEF_VAR(nid,"LONV",NF_FLOAT,1,id_lonv,vid_lonv)
-        ierr=NF_DEF_VAR(nid,"LATU",NF_FLOAT,1,id_latu,vid_latu)
-        ierr=NF_DEF_VAR(nid,"LATV",NF_FLOAT,1,id_latv,vid_latv)
-        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
-        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
-        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
-        
-        ierr=NF_ENDDEF(nid)
-
-! Enregistrement des variables dimensions
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi)
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi)
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_latu,rlatu*180./pi)
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_latv,rlatv*180./pi)
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lev,presnivs)
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
-        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
-#else
-        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
-        ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi)
-        ierr = NF_PUT_VAR_REAL(nid,vid_latu,rlatu*180./pi)
-        ierr = NF_PUT_VAR_REAL(nid,vid_latv,rlatv*180./pi)
-        ierr = NF_PUT_VAR_REAL(nid,vid_lev,presnivs)
-        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
-        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
-#endif
-! --------------------------------------------------------------------
-! Cr�ation des variables sauvegard�es
-! --------------------------------------------------------------------
-        ierr = NF_REDEF(nid)
-! Surface pressure (GCM)
-        dim3=(/id_lonv,id_latu,id_tim/)
-        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,3,dim3,varid)
-! Surface pressure (guidage)
-        IF (guide_P) THEN
-            dim3=(/id_lonv,id_latu,id_tim/)
-            ierr = NF_DEF_VAR(nid,"ps",NF_FLOAT,3,dim3,varid)
-        ENDIF
-! Zonal wind
-        IF (guide_u) THEN
-            dim4=(/id_lonu,id_latu,id_lev,id_tim/)
-            ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
-        ENDIF
-! Merid. wind
-        IF (guide_v) THEN
-            dim4=(/id_lonv,id_latv,id_lev,id_tim/)
-            ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
-        ENDIF
-! Pot. Temperature
-        IF (guide_T) THEN
-            dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-            ierr = NF_DEF_VAR(nid,"teta",NF_FLOAT,4,dim4,varid)
-        ENDIF
-! Specific Humidity
-        IF (guide_Q) THEN
-            dim4=(/id_lonv,id_latu,id_lev,id_tim/)
-            ierr = NF_DEF_VAR(nid,"q",NF_FLOAT,4,dim4,varid)
-        ENDIF
-        
-        ierr = NF_ENDDEF(nid)
-        ierr = NF_CLOSE(nid)
-    ENDIF ! timestep=0
-
-! --------------------------------------------------------------------
-! Enregistrement du champ
-! --------------------------------------------------------------------
-    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
-
-    SELECT CASE (varname)
-    CASE ("S")
-        timestep=timestep+1
-        ierr = NF_INQ_VARID(nid,"SP",varid)
-        start=(/1,1,timestep,0/)
-        count=(/iip1,jjp1,1,0/)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
-#else
-        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
-#endif
-    CASE ("P")
-        ierr = NF_INQ_VARID(nid,"ps",varid)
-        start=(/1,1,timestep,0/)
-        count=(/iip1,jjp1,1,0/)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
-#else
-        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
-#endif
-    CASE ("U")
-        ierr = NF_INQ_VARID(nid,"ucov",varid)
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
-#else
-        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
-#endif
-    CASE ("V")
-        ierr = NF_INQ_VARID(nid,"vcov",varid)
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjm,llm,1/)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
-#else
-        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
-#endif
-    CASE ("T")
-        ierr = NF_INQ_VARID(nid,"teta",varid)
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
-#else
-        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
-#endif
-    CASE ("Q")
-        ierr = NF_INQ_VARID(nid,"q",varid)
-        start=(/1,1,1,timestep/)
-        count=(/iip1,jjp1,llm,1/)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
-#else
-        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
-#endif
-    END SELECT
- 
-    ierr = NF_CLOSE(nid)
-
-  END SUBROUTINE guide_out
-    
-  
-!===========================================================================
-  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))
-              print*,'correction ',i,l,x(i,l),zz
-               x(i,l)=zz
-            endif
-         enddo
-     enddo
-     return
-  end subroutine correctbid
-
-!===========================================================================
-END MODULE guide_p_mod
Index: /LMDZ5/trunk/libf/dyn3dmem/infotrac.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/infotrac.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/infotrac.F90	(revision 1673)
@@ -32,4 +32,7 @@
   SUBROUTINE infotrac_init
     USE control_mod
+#ifdef REPROBUS
+    USE CHEM_REP, ONLY : Init_chem_rep_trac
+#endif
     IMPLICIT NONE
 !=======================================================================
@@ -61,10 +64,10 @@
     CHARACTER(len=1), DIMENSION(3)  :: txts
     CHARACTER(len=2), DIMENSION(9)  :: txtp
-    CHARACTER(len=13)               :: str1,str2
+    CHARACTER(len=23)               :: str1,str2
   
     INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
     INTEGER :: iq, new_iq, iiq, jq, ierr
-    INTEGER, EXTERNAL :: lnblnk
- 
+
+    character(len=*),parameter :: modname="infotrac_init"
 !-----------------------------------------------------------------------
 ! Initialization :
@@ -85,9 +88,36 @@
     
 
-    IF (config_inca=='none') THEN
-       type_trac='lmdz'
+    ! Coherence test between parameter type_trac, config_inca and preprocessing keys
+    IF (type_trac=='inca') THEN
+       WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
+            type_trac,' config_inca=',config_inca
+       IF (config_inca/='aero' .AND. config_inca/='chem') THEN
+          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
+          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
+       END IF
+#ifndef INCA
+       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
+       CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
+#endif
+    ELSE IF (type_trac=='repr') THEN
+       WRITE(lunout,*) 'You have choosen to couple with REPROBUS chemestry model : type_trac=', type_trac
+#ifndef REPROBUS
+       WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
+       CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1)
+#endif
+    ELSE IF (type_trac == 'lmdz') THEN
+       WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
     ELSE
-       type_trac='inca'
-    END IF
+       WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
+       CALL abort_gcm('infotrac_init','bad parameter',1)
+    END IF
+
+
+    ! Test if config_inca is other then none for run without INCA
+    IF (type_trac/='inca' .AND. config_inca/='none') THEN
+       WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
+       config_inca='none'
+    END IF
+
 
 !-----------------------------------------------------------------------
@@ -97,25 +127,43 @@
 !
 !-----------------------------------------------------------------------
-    IF (type_trac == 'lmdz') THEN
+    IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
        OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
        IF(ierr.EQ.0) THEN
-          WRITE(lunout,*) 'Open traceur.def : ok'
+          WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
           READ(90,*) nqtrue
        ELSE 
-          WRITE(lunout,*) 'Problem in opening traceur.def'
-          WRITE(lunout,*) 'ATTENTION using defaut values'
-          nqtrue=4 ! Defaut value
-       END IF
-       ! Attention! Only for planet_type=='earth'
-       nbtr=nqtrue-2
-    ELSE
-       ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F 
+          WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
+          WRITE(lunout,*) trim(modname),': WARNING using defaut values'
+          if (planet_type=='earth') then
+            nqtrue=4 ! Default value for Earth
+          else
+            nqtrue=1 ! Default value for other planets
+          endif
+       END IF
+       if ( planet_type=='earth') then
+         ! For Earth, water vapour & liquid tracers are not in the physics
+         nbtr=nqtrue-2
+       else
+         ! Other planets (for now); we have the same number of tracers
+         ! in the dynamics than in the physics
+         nbtr=nqtrue
+       endif
+    ELSE ! type_trac=inca
+       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 
        nqtrue=nbtr+2
     END IF
 
-    IF (nqtrue < 2) THEN
-       WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
+    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
+       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
        CALL abort_gcm('infotrac_init','Not enough tracers',1)
     END IF
+    
+! Transfert number of tracers to Reprobus
+    IF (type_trac == 'repr') THEN
+#ifdef REPROBUS
+       CALL Init_chem_rep_trac(nbtr)
+#endif
+    END IF
+       
 !
 ! Allocate variables depending on nqtrue and nbtr
@@ -152,12 +200,14 @@
 !    Get choice of advection schema from file tracer.def or from INCA
 !---------------------------------------------------------------------
-    IF (type_trac == 'lmdz') THEN
+    IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
        IF(ierr.EQ.0) THEN
           ! Continue to read tracer.def
           DO iq=1,nqtrue
-             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
+             READ(90,*) hadv(iq),vadv(iq),tnom_0(iq)
           END DO
           CLOSE(90)  
-       ELSE ! Without tracer.def
+       ELSE ! Without tracer.def, set default values 
+         if (planet_type=="earth") then
+          ! for Earth, default is to have 4 tracers
           hadv(1) = 14
           vadv(1) = 14
@@ -172,8 +222,13 @@
           vadv(4) = 10
           tnom_0(4) = 'PB'
+         else ! default for other planets
+          hadv(1) = 10
+          vadv(1) = 10
+          tnom_0(1) = 'dummy'
+         endif ! of if (planet_type=="earth")
        END IF
        
-       WRITE(lunout,*) 'Valeur de traceur.def :'
-       WRITE(lunout,*) 'nombre de traceurs ',nqtrue
+       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
+       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
        DO iq=1,nqtrue
           WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
@@ -217,5 +272,5 @@
           new_iq=new_iq+10 ! 9 tracers added
        ELSE
-          WRITE(lunout,*) 'This choice of advection schema is not available'
+          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
        END IF
@@ -227,8 +282,8 @@
        nqtot = new_iq
 
-       WRITE(lunout,*) 'The choice of advection schema for one or more tracers'
+       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
        WRITE(lunout,*) 'makes it necessary to add tracers'
-       WRITE(lunout,*) nqtrue,' is the number of true tracers'
-       WRITE(lunout,*) nqtot, ' is the total number of tracers needed'
+       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
+       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
 
     ELSE
@@ -258,5 +313,6 @@
           iadv(new_iq)=11
        ELSE
-          WRITE(lunout,*)'This choice of advection schema is not available'
+          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
+
           CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
        END IF
@@ -265,7 +321,7 @@
        tname(new_iq)= tnom_0(iq)
        IF (iadv(new_iq)==0) THEN
-          ttext(new_iq)=str1(1:lnblnk(str1))
+          ttext(new_iq)=trim(str1)
        ELSE
-          ttext(new_iq)=str1(1:lnblnk(str1))//descrq(iadv(new_iq))
+          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
        END IF
 
@@ -276,6 +332,6 @@
              new_iq=new_iq+1
              iadv(new_iq)=-20
-             ttext(new_iq)=str2(1:lnblnk(str2))//txts(jq)
-             tname(new_iq)=str1(1:lnblnk(str1))//txts(jq)
+             ttext(new_iq)=trim(str2)//txts(jq)
+             tname(new_iq)=trim(str1)//txts(jq)
           END DO
        ELSE IF (iadv(new_iq)==30) THEN
@@ -283,6 +339,6 @@
              new_iq=new_iq+1
              iadv(new_iq)=-30
-             ttext(new_iq)=str2(1:lnblnk(str2))//txtp(jq)
-             tname(new_iq)=str1(1:lnblnk(str1))//txtp(jq)
+             ttext(new_iq)=trim(str2)//txtp(jq)
+             tname(new_iq)=trim(str1)//txtp(jq)
           END DO
        END IF
@@ -303,8 +359,9 @@
 
 
-    WRITE(lunout,*) 'Information stored in infotrac :'
-    WRITE(lunout,*) 'iadv  niadv tname  ttext :'
+    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
+    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
     DO iq=1,nqtot
-       WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq)
+       WRITE(lunout,*) iadv(iq),niadv(iq),&
+       ' ',trim(tname(iq)),' ',trim(ttext(iq))
     END DO
 
@@ -315,8 +372,8 @@
     DO iq=1,nqtot
        IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
-          WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
+          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
           CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
        ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
-          WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
+          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
           CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
        END IF
@@ -329,6 +386,4 @@
     DEALLOCATE(tracnam)
 
-999 FORMAT (i2,1x,i2,1x,a15)
-
   END SUBROUTINE infotrac_init
 
Index: DZ5/trunk/libf/dyn3dmem/iniacademic.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/iniacademic.F	(revision 1672)
+++ 	(revision )
@@ -1,220 +1,0 @@
-!
-! $Id: iniacademic.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-c
-c
-      SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
-
-      USE filtreg_mod
-      USE infotrac, ONLY : nqtot
-      USE control_mod
- 
-
-c%W%    %G%
-c=======================================================================
-c
-c   Author:    Frederic Hourdin      original: 15/01/93
-c   -------
-c
-c   Subject:
-c   ------
-c
-c   Method:
-c   --------
-c
-c   Interface:
-c   ----------
-c
-c      Input:
-c      ------
-c
-c      Output:
-c      -------
-c
-c=======================================================================
-      IMPLICIT NONE
-c-----------------------------------------------------------------------
-c   Declararations:
-c   ---------------
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comvert.h"
-#include "comconst.h"
-#include "comgeom.h"
-#include "academic.h"
-#include "ener.h"
-#include "temps.h"
-#include "iniprint.h"
-#include "logic.h"
-
-c   Arguments:
-c   ----------
-
-      real time_0
-
-c   variables dynamiques
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
-      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
-      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
-      REAL ps(ip1jmp1)                       ! pression  au sol
-      REAL masse(ip1jmp1,llm)                ! masse d'air
-      REAL phis(ip1jmp1)                     ! geopotentiel au sol
-
-c   Local:
-c   ------
-
-      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 phi(ip1jmp1,llm)                  ! geopotentiel
-      REAL ddsin,tetarappelj,tetarappell,zsig
-      real tetajl(jjp1,llm)
-      INTEGER i,j,l,lsup,ij
-
-      real zz,ran1
-      integer idum
-
-      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
-
-c-----------------------------------------------------------------------
-! 1. Initializations for Earth-like case
-! --------------------------------------
-      if (planet_type=="earth") then
-c
-        time_0=0.
-        day_ref=0
-        annee_ref=0
-
-        im         = iim
-        jm         = jjm
-        day_ini    = 0
-        omeg       = 4.*asin(1.)/86400.
-        rad    = 6371229.
-        g      = 9.8
-        daysec = 86400.
-        dtvr    = daysec/REAL(day_step)
-        zdtvr=dtvr
-        kappa  = 0.2857143
-        cpp    = 1004.70885
-        preff     = 101325.
-        pa        =  50000.
-        etot0      = 0.
-        ptot0      = 0.
-        ztot0      = 0.
-        stot0      = 0.
-        ang0       = 0.
-
-        if (llm.eq.1) then
-          ! specific initializations for the shallow water case
-          kappa=1
-        endif
-        
-        CALL iniconst
-        CALL inigeom
-        CALL inifilr
-
-        if (llm.eq.1) then
-          ! initialize fields for the shallow water case, if required
-          if (.not.read_start) then
-            phis(:)=0.
-            q(:,:,1)=1.e-10
-            q(:,:,2)=1.e-15
-            q(:,:,3:nqtot)=0.
-            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
-          endif
-        endif
-
-        if (iflag_phys.eq.2) then
-          ! initializations for the academic case
-          ps(:)=1.e5
-          phis(:)=0.
-c---------------------------------------------------------------------
-
-          taurappel=10.*daysec
-
-c---------------------------------------------------------------------
-c   Calcul de la temperature potentielle :
-c   --------------------------------------
-
-          DO l=1,llm
-            zsig=ap(l)/preff+bp(l)
-            if (zsig.gt.0.3) then
-             lsup=l
-             tetarappell=1./8.*(-log(zsig)-.5)
-             DO j=1,jjp1
-             ddsin=sin(rlatu(j))-sin(pi/20.)
-             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
-             ENDDO
-            else
-c   Choix isotherme au-dessus de 300 mbar
-             do j=1,jjp1
-               tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
-             enddo
-            endif ! of if (zsig.gt.0.3)
-          ENDDO ! of DO l=1,llm
-
-          do l=1,llm
-            do j=1,jjp1
-              do i=1,iip1
-                 ij=(j-1)*iip1+i
-                 tetarappel(ij,l)=tetajl(j,l)
-              enddo
-            enddo
-          enddo
-
-c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
-
-          CALL pression ( ip1jmp1, ap, bp, ps, p       )
-          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
-          CALL massdair(p,masse)
-
-c  intialisation du vent et de la temperature
-          teta(:,:)=tetarappel(:,:)
-          CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
-          call ugeostr(phi,ucov)
-          vcov=0.
-          q(:,:,1   )=1.e-10
-          q(:,:,2   )=1.e-15
-          q(:,:,3:nqtot)=0.
-
-
-c   perturbation aleatoire sur la temperature
-          idum  = -1
-          zz = ran1(idum)
-          idum  = 0
-          do l=1,llm
-            do ij=iip2,ip1jm
-              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
-            enddo
-          enddo
-
-          do l=1,llm
-            do ij=1,ip1jmp1,iip1
-              teta(ij+iim,l)=teta(ij,l)
-            enddo
-          enddo
-
-
-
-c     PRINT *,' Appel test_period avec tetarappel '
-c     CALL  test_period ( ucov,vcov,tetarappel,q,p,phis )
-c     PRINT *,' Appel test_period avec teta '
-c     CALL  test_period ( ucov,vcov,teta,q,p,phis )
-
-c   initialisation d'un traceur sur une colonne
-          j=jjp1*3/4
-          i=iip1/2
-          ij=(j-1)*iip1+i
-          q(ij,:,3)=1.
-        endif ! of if (iflag_phys.eq.2)
-        
-      else
-        write(lunout,*)"iniacademic: planet types other than earth",
-     &                 " not implemented (yet)."
-        stop
-      endif ! of if (planet_type=="earth")
-      return
-      END
-c-----------------------------------------------------------------------
Index: /LMDZ5/trunk/libf/dyn3dmem/iniacademic.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/iniacademic.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/iniacademic.F90	(revision 1673)
@@ -0,0 +1,277 @@
+!
+! $Id: iniacademic.F90 1625 2012-05-09 13:14:48Z lguez $
+!
+SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
+
+  USE filtreg_mod
+  USE infotrac, ONLY : nqtot
+  USE control_mod, ONLY: day_step,planet_type
+#ifdef CPP_IOIPSL
+  USE IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  USE ioipsl_getincom
+#endif
+  USE Write_Field
+
+  !   Author:    Frederic Hourdin      original: 15/01/93
+  ! The forcing defined here is from Held and Suarez, 1994, Bulletin
+  ! of the American Meteorological Society, 75, 1825.
+
+  IMPLICIT NONE
+
+  !   Declararations:
+  !   ---------------
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comvert.h"
+  include "comconst.h"
+  include "comgeom.h"
+  include "academic.h"
+  include "ener.h"
+  include "temps.h"
+  include "iniprint.h"
+  include "logic.h"
+
+  !   Arguments:
+  !   ----------
+
+  real time_0
+
+  !   variables dynamiques
+  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+  REAL teta(ip1jmp1,llm)                 ! temperature potentielle
+  REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
+  REAL ps(ip1jmp1)                       ! pression  au sol
+  REAL masse(ip1jmp1,llm)                ! masse d'air
+  REAL phis(ip1jmp1)                     ! geopotentiel au sol
+
+  !   Local:
+  !   ------
+
+  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 phi(ip1jmp1,llm)                  ! geopotentiel
+  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
+  real tetastrat ! potential temperature in the stratosphere, in K
+  real tetajl(jjp1,llm)
+  INTEGER i,j,l,lsup,ij
+
+  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
+  REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
+  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
+  LOGICAL ok_pv                ! Polar Vortex
+  REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex 
+
+  real zz,ran1
+  integer idum
+
+  REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
+  
+  character(len=*),parameter :: modname="iniacademic"
+  character(len=80) :: abort_message
+
+  !-----------------------------------------------------------------------
+  ! 1. Initializations for Earth-like case
+  ! --------------------------------------
+  !
+  ! initialize planet radius, rotation rate,...
+  call conf_planete
+
+  time_0=0.
+  day_ref=1
+  annee_ref=0
+
+  im         = iim
+  jm         = jjm
+  day_ini    = 1
+  dtvr    = daysec/REAL(day_step)
+  zdtvr=dtvr
+  etot0      = 0.
+  ptot0      = 0.
+  ztot0      = 0.
+  stot0      = 0.
+  ang0       = 0.
+
+  if (llm == 1) then
+     ! specific initializations for the shallow water case
+     kappa=1
+  endif
+
+  CALL iniconst
+  CALL inigeom
+  CALL inifilr
+
+  if (llm == 1) then
+     ! initialize fields for the shallow water case, if required
+     if (.not.read_start) then
+        phis(:)=0.
+        q(:,:,:)=0
+        CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
+     endif
+  endif
+
+  academic_case: if (iflag_phys >= 2) then
+     ! initializations
+
+     ! 1. local parameters
+     ! by convention, winter is in the southern hemisphere
+     ! Geostrophic wind or no wind?
+     ok_geost=.TRUE.
+     CALL getin('ok_geost',ok_geost)
+     ! Constants for Newtonian relaxation and friction
+     k_f=1.                !friction 
+     CALL getin('k_j',k_f)
+     k_f=1./(daysec*k_f)
+     k_c_s=4.  !cooling surface
+     CALL getin('k_c_s',k_c_s)
+     k_c_s=1./(daysec*k_c_s)
+     k_c_a=40. !cooling free atm
+     CALL getin('k_c_a',k_c_a)
+     k_c_a=1./(daysec*k_c_a)
+     ! Constants for Teta equilibrium profile
+     teta0=315.     ! mean Teta (S.H. 315K)
+     CALL getin('teta0',teta0)
+     ttp=200.       ! Tropopause temperature (S.H. 200K)
+     CALL getin('ttp',ttp)
+     eps=0.         ! Deviation to N-S symmetry(~0-20K)
+     CALL getin('eps',eps)
+     delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
+     CALL getin('delt_y',delt_y)
+     delt_z=10.     ! Vertical Gradient (S.H. 10K)
+     CALL getin('delt_z',delt_z)
+     ! Polar vortex
+     ok_pv=.false.
+     CALL getin('ok_pv',ok_pv)
+     phi_pv=-50.            ! Latitude of edge of vortex
+     CALL getin('phi_pv',phi_pv)
+     phi_pv=phi_pv*pi/180.
+     dphi_pv=5.             ! Width of the edge
+     CALL getin('dphi_pv',dphi_pv)
+     dphi_pv=dphi_pv*pi/180.
+     gam_pv=4.              ! -dT/dz vortex (in K/km)
+     CALL getin('gam_pv',gam_pv)
+
+     ! 2. Initialize fields towards which to relax
+     ! Friction
+     knewt_g=k_c_a
+     DO l=1,llm
+        zsig=presnivs(l)/preff
+        knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
+        kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
+     ENDDO
+     DO j=1,jjp1
+        clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
+     ENDDO
+
+     ! Potential temperature 
+     DO l=1,llm
+        zsig=presnivs(l)/preff
+        tetastrat=ttp*zsig**(-kappa)
+        tetapv=tetastrat
+        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
+           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
+        ENDIF
+        DO j=1,jjp1
+           ! Troposphere
+           ddsin=sin(rlatu(j))
+           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
+                -delt_z*(1.-ddsin*ddsin)*log(zsig)
+           if (planet_type=="giant") then
+             tetajl(j,l)=teta0+(delt_y*                   &
+                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
+                / ((rlatu(j)*3.14159*eps+0.0001)**2))     &
+                -delt_z*log(zsig)
+           endif
+           ! Profil stratospherique isotherme (+vortex)
+           w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
+           tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
+           tetajl(j,l)=MAX(tetajl(j,l),tetastrat)  
+        ENDDO
+     ENDDO
+
+     !          CALL writefield('theta_eq',tetajl)
+
+     do l=1,llm
+        do j=1,jjp1
+           do i=1,iip1
+              ij=(j-1)*iip1+i
+              tetarappel(ij,l)=tetajl(j,l)
+           enddo
+        enddo
+     enddo
+
+     ! 3. Initialize fields (if necessary)
+     IF (.NOT. read_start) THEN
+        ! surface pressure
+        if (iflag_phys>2) then
+           ! specific value for CMIP5 aqua/terra planets
+           ! "Specify the initial dry mass to be equivalent to
+           !  a global mean surface pressure (101325 minus 245) Pa."
+           ps(:)=101080.  
+        else
+           ! use reference surface pressure
+           ps(:)=preff
+        endif
+        
+        ! ground geopotential
+        phis(:)=0.
+
+        CALL pression ( ip1jmp1, ap, bp, ps, p       )
+        if (pressure_exner) then
+          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        else
+          call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
+        endif
+        CALL massdair(p,masse)
+
+        ! bulk initialization of temperature
+        teta(:,:)=tetarappel(:,:)
+
+        ! geopotential
+        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
+
+        ! winds
+        if (ok_geost) then
+           call ugeostr(phi,ucov)
+        else
+           ucov(:,:)=0.
+        endif
+        vcov(:,:)=0.
+
+        ! bulk initialization of tracers
+        if (planet_type=="earth") then
+           ! Earth: first two tracers will be water
+           do i=1,nqtot
+              if (i == 1) q(:,:,i)=1.e-10
+              if (i == 2) q(:,:,i)=1.e-15
+              if (i.gt.2) q(:,:,i)=0.
+           enddo
+        else
+           q(:,:,:)=0
+        endif ! of if (planet_type=="earth")
+
+        ! add random perturbation to temperature
+        idum  = -1
+        zz = ran1(idum)
+        idum  = 0
+        do l=1,llm
+           do ij=iip2,ip1jm
+              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
+           enddo
+        enddo
+
+        ! maintain periodicity in longitude
+        do l=1,llm
+           do ij=1,ip1jmp1,iip1
+              teta(ij+iim,l)=teta(ij,l)
+           enddo
+        enddo
+
+     ENDIF ! of IF (.NOT. read_start)
+  endif academic_case
+
+END SUBROUTINE iniacademic
Index: DZ5/trunk/libf/dyn3dmem/iniconst.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/iniconst.F	(revision 1672)
+++ 	(revision )
@@ -1,65 +1,0 @@
-!
-! $Id: iniconst.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE iniconst
-
-      USE control_mod
-
-      IMPLICIT NONE
-c
-c      P. Le Van
-c
-c-----------------------------------------------------------------------
-c   Declarations:
-c   -------------
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "temps.h"
-#include "comvert.h"
-#include "iniprint.h"
-
-
-c
-c
-c
-c-----------------------------------------------------------------------
-c   dimension des boucles:
-c   ----------------------
-
-      im      = iim
-      jm      = jjm
-      lllm    = llm
-      imp1    = iim 
-      jmp1    = jjm + 1
-      lllmm1  = llm - 1
-      lllmp1  = llm + 1
-
-      if (planet_type=="earth") then
-        disvert_type=1
-      else
-        disvert_type=2
-      endif
-
-c-----------------------------------------------------------------------
-
-      dtdiss  = idissip * dtvr
-      dtphys  = iphysiq * dtvr
-      unsim   = 1./iim
-      pi      = 2.*ASIN( 1. )
-
-c-----------------------------------------------------------------------
-c
-
-      r       = cpp * kappa
-
-      write(lunout,*)'iniconst: R  CP  Kappa ',  r , cpp,  kappa
-c
-c-----------------------------------------------------------------------
-
-       CALL disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig)
-c
-c
-       RETURN
-       END
Index: /LMDZ5/trunk/libf/dyn3dmem/iniconst.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/iniconst.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/iniconst.F90	(revision 1673)
@@ -0,0 +1,84 @@
+!
+! $Id: iniconst.F90 1625 2012-05-09 13:14:48Z lguez $
+!
+SUBROUTINE iniconst
+
+  USE control_mod
+#ifdef CPP_IOIPSL
+  use IOIPSL
+#else
+  ! if not using IOIPSL, we still need to use (a local version of) getin
+  use ioipsl_getincom
+#endif
+
+  IMPLICIT NONE
+  !
+  !      P. Le Van
+  !
+  !   Declarations:
+  !   -------------
+  !
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "temps.h"
+  include "comvert.h"
+  include "iniprint.h"
+
+  character(len=*),parameter :: modname="iniconst"
+  character(len=80) :: abort_message
+  !
+  !
+  !
+  !-----------------------------------------------------------------------
+  !   dimension des boucles:
+  !   ----------------------
+
+  im      = iim
+  jm      = jjm
+  lllm    = llm
+  imp1    = iim 
+  jmp1    = jjm + 1
+  lllmm1  = llm - 1
+  lllmp1  = llm + 1
+
+  !-----------------------------------------------------------------------
+
+  dtphys  = iphysiq * dtvr
+  unsim   = 1./iim
+  pi      = 2.*ASIN( 1. )
+
+  !-----------------------------------------------------------------------
+  !
+
+  r       = cpp * kappa
+
+  write(lunout,*) trim(modname),': R  CP  Kappa ',r,cpp,kappa
+  !
+  !-----------------------------------------------------------------------
+
+  ! vertical discretization: default behavior depends on planet_type flag
+  if (planet_type=="earth") then
+     disvert_type=1
+  else
+     disvert_type=2
+  endif
+  ! but user can also specify using one or the other in run.def:
+  call getin('disvert_type',disvert_type)
+  write(lunout,*) trim(modname),': disvert_type=',disvert_type
+
+  pressure_exner = disvert_type == 1 ! default value
+  call getin('pressure_exner', pressure_exner)
+
+  if (disvert_type==1) then
+     ! standard case for Earth (automatic generation of levels)
+     call disvert(pa,preff,ap,bp,dpres,presnivs,nivsigs,nivsig, scaleheight)
+  else if (disvert_type==2) then
+     ! standard case for planets (levels generated using z2sig.def file)
+     call disvert_noterre
+  else
+     write(abort_message,*) "Wrong value for disvert_type: ", disvert_type
+     call abort_gcm(modname,abort_message,0)
+  endif
+
+END SUBROUTINE iniconst
Index: DZ5/trunk/libf/dyn3dmem/inidissip.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/inidissip.F	(revision 1672)
+++ 	(revision )
@@ -1,226 +1,0 @@
-!
-! $Id: inidissip.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
-     *                       tetagdiv,tetagrot,tetatemp             )
-c=======================================================================
-c   initialisation de la dissipation horizontale
-c=======================================================================
-c-----------------------------------------------------------------------
-c   declarations:
-c   -------------
-
-      USE control_mod
-
-      IMPLICIT NONE
-#include "dimensions.h"
-#include "paramet.h"
-#include "comdissipn.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "logic.h"
-
-      LOGICAL lstardis
-      INTEGER nitergdiv,nitergrot,niterh
-      REAL    tetagdiv,tetagrot,tetatemp
-      REAL fact,zvert(llm),zz
-      REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
-      REAL ullm,vllm,umin,vmin,zhmin,zhmax
-      REAL zllm,z1llm
-
-      INTEGER l,ij,idum,ii
-      REAL tetamin
-      REAL pseudoz
-
-      REAL ran1
-
-
-c-----------------------------------------------------------------------
-c
-c   calcul des valeurs propres des operateurs par methode iterrative:
-c   -----------------------------------------------------------------
-
-      crot     = -1.
-      cdivu    = -1.
-      cdivh    = -1.
-
-c   calcul de la valeur propre de divgrad:
-c   --------------------------------------
-      idum = 0
-      DO l = 1, llm
-       DO ij = 1, ip1jmp1
-        deltap(ij,l) = 1.
-       ENDDO
-      ENDDO
-
-      idum  = -1
-      zh(1) = RAN1(idum)-.5
-      idum  = 0
-      DO ij = 2, ip1jmp1
-        zh(ij) = RAN1(idum) -.5
-      ENDDO
-
-      CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
-
-      CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
-
-      IF ( zhmin .GE. zhmax  )     THEN
-         PRINT*,'  Inidissip  zh min max  ',zhmin,zhmax
-         STOP'probleme generateur alleatoire dans inidissip'
-      ENDIF
-
-      zllm = ABS( zhmax )
-      DO l = 1,50
-         IF(lstardis) THEN
-            CALL divgrad2(1,zh,deltap,niterh,zh)
-         ELSE
-            CALL divgrad (1,zh,niterh,zh)
-         ENDIF
-
-        CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
-
-         zllm  = ABS( zhmax )
-         z1llm = 1./zllm
-         DO ij = 1,ip1jmp1
-            zh(ij) = zh(ij)* z1llm
-         ENDDO
-      ENDDO
-
-      IF(lstardis) THEN
-         cdivh = 1./ zllm
-      ELSE
-         cdivh = zllm ** ( -1./niterh )
-      ENDIF
-
-c   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
-c   -----------------------------------------------------------------
-      print*,'calcul des valeurs propres'
-
-      DO  20  ii = 1, 2
-c
-         DO ij = 1, ip1jmp1
-           zu(ij)  = RAN1(idum) -.5
-         ENDDO
-         CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
-         DO ij = 1, ip1jm
-            zv(ij) = RAN1(idum) -.5
-         ENDDO
-         CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
-
-         CALL minmax(iip1*jjp1,zu,umin,ullm )
-         CALL minmax(iip1*jjm, zv,vmin,vllm )
-
-         ullm = ABS ( ullm )
-         vllm = ABS ( vllm )
-
-         DO  5  l = 1, 50
-            IF(ii.EQ.1) THEN
-ccccc             CALL covcont( 1,zu,zv,zu,zv )
-               IF(lstardis) THEN
-                  CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
-               ELSE
-                  CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
-               ENDIF
-            ELSE
-               IF(lstardis) THEN
-                  CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
-               ELSE
-                  CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
-               ENDIF
-            ENDIF
-
-            CALL minmax(iip1*jjp1,zu,umin,ullm )
-            CALL minmax(iip1*jjm, zv,vmin,vllm )
-
-            ullm = ABS  ( ullm )
-            vllm = ABS  ( vllm )
-
-            zllm  = MAX( ullm,vllm )
-            z1llm = 1./ zllm
-            DO ij = 1, ip1jmp1
-              zu(ij) = zu(ij)* z1llm
-            ENDDO
-            DO ij = 1, ip1jm
-               zv(ij) = zv(ij)* z1llm
-            ENDDO
- 5       CONTINUE
-
-         IF ( ii.EQ.1 ) THEN
-            IF(lstardis) THEN
-               cdivu  = 1./zllm
-            ELSE
-               cdivu  = zllm **( -1./nitergdiv )
-            ENDIF
-         ELSE
-            IF(lstardis) THEN
-               crot   = 1./ zllm
-            ELSE
-               crot   = zllm **( -1./nitergrot )
-            ENDIF
-         ENDIF
-
- 20   CONTINUE
-
-c   petit test pour les operateurs non star:
-c   ----------------------------------------
-
-c     IF(.NOT.lstardis) THEN
-         fact    = rad*24./REAL(jjm)
-         fact    = fact*fact
-         PRINT*,'coef u ', fact/cdivu, 1./cdivu
-         PRINT*,'coef r ', fact/crot , 1./crot
-         PRINT*,'coef h ', fact/cdivh, 1./cdivh
-c     ENDIF
-
-c-----------------------------------------------------------------------
-c   variation verticale du coefficient de dissipation:
-c   --------------------------------------------------
-
-      if (ok_strato .and. llm==39) then
-         do l=1,llm
-            pseudoz=8.*log(preff/presnivs(l))
-            zvert(l)=1+
-     s      (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2.
-     s      *(dissip_factz-1.)
-         enddo 
-      else
-         DO l=1,llm
-            zvert(l)=1.
-         ENDDO
-         fact=2.
-         DO l = 1, llm
-            zz      = 1. - preff/presnivs(l)
-            zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
-         ENDDO
-      endif
-
-
-      PRINT*,'Constantes de temps de la diffusion horizontale'
-
-      tetamin =  1.e+6
-
-      DO l=1,llm
-        tetaudiv(l)   = zvert(l)/tetagdiv
-        tetaurot(l)   = zvert(l)/tetagrot
-        tetah(l)      = zvert(l)/tetatemp
-
-        IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
-        IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
-        IF( tetamin.GT. (1./   tetah(l)) ) tetamin = 1./    tetah(l)
-      ENDDO
-
-      PRINT *,' INIDI tetamin dtvr ',tetamin,dtvr,iperiod
-      idissip = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
-      PRINT *,' INIDI tetamin idissip ',tetamin,idissip
-      idissip = MAX(iperiod,idissip)
-      dtdiss  = idissip * dtvr
-      PRINT *,' INIDI idissip dtdiss ',idissip,dtdiss
-
-      DO l = 1,llm
-         PRINT*,zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l),
-     *                   dtdiss*tetah(l)
-      ENDDO
-
-c
-      RETURN
-      END
Index: /LMDZ5/trunk/libf/dyn3dmem/inidissip.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/inidissip.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/inidissip.F90	(revision 1673)
@@ -0,0 +1,217 @@
+!
+! $Id: inidissip.F90 1611 2012-01-25 14:31:54Z lguez $
+!
+SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  , &
+     tetagdiv,tetagrot,tetatemp             )
+  !=======================================================================
+  !   initialisation de la dissipation horizontale
+  !=======================================================================
+  !-----------------------------------------------------------------------
+  !   declarations:
+  !   -------------
+
+  USE control_mod, only : dissip_period,iperiod
+
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "comdissipn.h"
+  include "comconst.h"
+  include "comvert.h"
+  include "logic.h"
+  include "iniprint.h"
+
+  LOGICAL,INTENT(in) :: lstardis
+  INTEGER,INTENT(in) :: nitergdiv,nitergrot,niterh
+  REAL,INTENT(in) :: tetagdiv,tetagrot,tetatemp
+
+! Local variables:
+  REAL fact,zvert(llm),zz
+  REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
+  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
+  REAL ullm,vllm,umin,vmin,zhmin,zhmax
+  REAL zllm
+
+  INTEGER l,ij,idum,ii
+  REAL tetamin
+  REAL pseudoz
+  character (len=80) :: abort_message
+
+  REAL ran1
+
+
+  !-----------------------------------------------------------------------
+  !
+  !   calcul des valeurs propres des operateurs par methode iterrative:
+  !   -----------------------------------------------------------------
+
+  crot     = -1.
+  cdivu    = -1.
+  cdivh    = -1.
+
+  !   calcul de la valeur propre de divgrad:
+  !   --------------------------------------
+  idum = 0
+  DO l = 1, llm
+     DO ij = 1, ip1jmp1
+        deltap(ij,l) = 1.
+     ENDDO
+  ENDDO
+
+  idum  = -1
+  zh(1) = RAN1(idum)-.5
+  idum  = 0
+  DO ij = 2, ip1jmp1
+     zh(ij) = RAN1(idum) -.5
+  ENDDO
+
+  CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
+
+  CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
+
+  IF ( zhmin .GE. zhmax  )     THEN
+     write(lunout,*)'  Inidissip  zh min max  ',zhmin,zhmax
+     abort_message='probleme generateur alleatoire dans inidissip'
+     call abort_gcm('inidissip',abort_message,1)
+  ENDIF
+
+  zllm = ABS( zhmax )
+  DO l = 1,50
+     IF(lstardis) THEN
+        CALL divgrad2(1,zh,deltap,niterh,divgra)
+     ELSE
+        CALL divgrad (1,zh,niterh,divgra)
+     ENDIF
+
+     zllm  = ABS(maxval(divgra))
+     zh = divgra / zllm
+  ENDDO
+
+  IF(lstardis) THEN
+     cdivh = 1./ zllm
+  ELSE
+     cdivh = zllm ** ( -1./niterh )
+  ENDIF
+
+  !   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
+  !   -----------------------------------------------------------------
+  write(lunout,*)'inidissip: calcul des valeurs propres'
+
+  DO    ii = 1, 2
+     !
+     DO ij = 1, ip1jmp1
+        zu(ij)  = RAN1(idum) -.5
+     ENDDO
+     CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
+     DO ij = 1, ip1jm
+        zv(ij) = RAN1(idum) -.5
+     ENDDO
+     CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
+
+     CALL minmax(iip1*jjp1,zu,umin,ullm )
+     CALL minmax(iip1*jjm, zv,vmin,vllm )
+
+     ullm = ABS ( ullm )
+     vllm = ABS ( vllm )
+
+     DO    l = 1, 50
+        IF(ii.EQ.1) THEN
+           !cccc             CALL covcont( 1,zu,zv,zu,zv )
+           IF(lstardis) THEN
+              CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
+           ELSE
+              CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
+           ENDIF
+        ELSE
+           IF(lstardis) THEN
+              CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
+           ELSE
+              CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
+           ENDIF
+        ENDIF
+
+        zllm = max(abs(maxval(gx)), abs(maxval(gy)))
+        zu = gx / zllm
+        zv = gy / zllm
+     end DO
+
+     IF ( ii.EQ.1 ) THEN
+        IF(lstardis) THEN
+           cdivu  = 1./zllm
+        ELSE
+           cdivu  = zllm **( -1./nitergdiv )
+        ENDIF
+     ELSE
+        IF(lstardis) THEN
+           crot   = 1./ zllm
+        ELSE
+           crot   = zllm **( -1./nitergrot )
+        ENDIF
+     ENDIF
+
+  end DO
+
+  !   petit test pour les operateurs non star:
+  !   ----------------------------------------
+
+  !     IF(.NOT.lstardis) THEN
+  fact    = rad*24./REAL(jjm)
+  fact    = fact*fact
+  write(lunout,*)'inidissip: coef u ', fact/cdivu, 1./cdivu
+  write(lunout,*)'inidissip: coef r ', fact/crot , 1./crot
+  write(lunout,*)'inidissip: coef h ', fact/cdivh, 1./cdivh
+  !     ENDIF
+
+  !-----------------------------------------------------------------------
+  !   variation verticale du coefficient de dissipation:
+  !   --------------------------------------------------
+
+  if (ok_strato .and. llm==39) then
+     do l=1,llm
+        pseudoz=8.*log(preff/presnivs(l))
+        zvert(l)=1+ &
+             (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2. &
+             *(dissip_factz-1.)
+     enddo
+  else
+     DO l=1,llm
+        zvert(l)=1.
+     ENDDO
+     fact=2.
+     DO l = 1, llm
+        zz      = 1. - preff/presnivs(l)
+        zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
+     ENDDO
+  endif
+
+
+  write(lunout,*)'inidissip: Constantes de temps de la diffusion horizontale'
+
+  tetamin =  1.e+6
+
+  DO l=1,llm
+     tetaudiv(l)   = zvert(l)/tetagdiv
+     tetaurot(l)   = zvert(l)/tetagrot
+     tetah(l)      = zvert(l)/tetatemp
+
+     IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
+     IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
+     IF( tetamin.GT. (1./   tetah(l)) ) tetamin = 1./    tetah(l)
+  ENDDO
+
+  ! If dissip_period=0 calculate value for dissipation period, else keep value read from gcm.def
+  IF (dissip_period == 0) THEN
+     dissip_period = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
+     write(lunout,*)'inidissip: tetamin dtvr iperiod dissip_period(intermed) ',tetamin,dtvr,iperiod,dissip_period
+     dissip_period = MAX(iperiod,dissip_period)
+  END IF
+
+  dtdiss  = dissip_period * dtvr
+  write(lunout,*)'inidissip: dissip_period=',dissip_period,' dtdiss=',dtdiss,' dtvr=',dtvr
+
+  DO l = 1,llm
+     write(lunout,*)zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l), &
+          dtdiss*tetah(l)
+  ENDDO
+
+END SUBROUTINE inidissip
Index: /LMDZ5/trunk/libf/dyn3dmem/inigrads.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/inigrads.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/inigrads.F	(revision 1673)
@@ -9,5 +9,5 @@
       implicit none
 
-      integer if,im,jm,lm,i,j,l,lnblnk
+      integer if,im,jm,lm,i,j,l
       real x(im),y(jm),z(lm),fx,fy,fz,dt
       real xmin,xmax,ymin,ymax
@@ -40,5 +40,5 @@
       ivar(if)=0
 
-      fichier(if)=file(1:lnblnk(file))
+      fichier(if)=trim(file)
 
       firsttime(if)=.true.
@@ -70,7 +70,7 @@
 
       print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
-      print*,file(1:lnblnk(file))//'.dat'
+      print*,trim(file)//'.dat'
 
-      OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat'
+      OPEN (unit(if)+1,FILE=trim(file)//'.dat'
      s   ,FORM='unformatted',
      s   ACCESS='direct'
Index: /LMDZ5/trunk/libf/dyn3dmem/initfluxsto_p.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/initfluxsto_p.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/initfluxsto_p.F	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: initfluxsto_p.F 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
       subroutine initfluxsto_p
@@ -203,9 +203,10 @@
      .              llm, nivsigs, zvertiid)
 c pour le fichier def
-      nivd(1) = 1
-      call histvert(filedid, 'sig_s', 'Niveaux sigma',
-     .  'sigma_level',
-     .              1, nivd, dvertiid)
-
+      if (mpi_rank==0) then
+         nivd(1) = 1
+         call histvert(filedid, 'sig_s', 'Niveaux sigma',
+     .        'sigma_level',
+     .        1, nivd, dvertiid)
+      endif
 C
 C  Appels a histdef pour la definition des variables a sauvegarder
@@ -282,9 +283,9 @@
       call histend(fileid)
       call histend(filevid)
-      call histend(filedid)
+      if (mpi_rank==0) call histend(filedid)
       if (ok_sync) then
         call histsync(fileid)
         call histsync(filevid)
-        call histsync(filedid)
+        if (mpi_rank==0) call histsync(filedid)
       endif
 	
Index: /LMDZ5/trunk/libf/dyn3dmem/integrd_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/integrd_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/integrd_loc.F	(revision 1673)
@@ -4,5 +4,5 @@
       SUBROUTINE integrd_loc
      $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
-     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
+     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis) !,finvmaold)
       USE parallel
       USE control_mod
@@ -37,4 +37,5 @@
 #include "temps.h"
 #include "serre.h"
+#include "iniprint.h"
       include 'mpif.h'
 
@@ -42,18 +43,26 @@
 c   ----------
 
-      INTEGER nq
-
-      REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
-      REAL teta(ijb_u:ije_u,llm)
-      REAL q(ijb_u:ije_u,llm,nq)
-      REAL ps0(ijb_u:ije_u),masse(ijb_u:ije_u,llm),phis(ijb_u:ije_u)
-
-      REAL vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm)
-      REAL tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u)
-      REAL massem1(ijb_u:ije_u,llm)
-
-      REAL dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm)
-      REAL dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u)
-      REAL dq(ijb_u:ije_u,llm,nq), finvmaold(ijb_u:ije_u,llm)
+      INTEGER,intent(in) :: nq ! number of tracers to handle in this routine
+
+      REAL,INTENT(INOUT) :: vcov(ijb_v:ije_v,llm) ! covariant meridional wind
+      REAL,INTENT(INOUT) :: ucov(ijb_u:ije_u,llm) ! covariant zonal wind
+      REAL,INTENT(INOUT) :: teta(ijb_u:ije_u,llm) ! potential temperature
+      REAL,INTENT(INOUT) :: q(ijb_u:ije_u,llm,nq) ! advected tracers
+      REAL,INTENT(INOUT) :: ps0(ijb_u:ije_u) ! surface pressure
+      REAL,INTENT(INOUT) :: masse(ijb_u:ije_u,llm) ! atmospheric mass
+      REAL,INTENT(INOUT) :: phis(ijb_u:ije_u) ! ground geopotential !!! unused
+      ! values at previous time step
+      REAL,INTENT(INOUT) :: vcovm1(ijb_v:ije_v,llm)
+      REAL,INTENT(INOUT) :: ucovm1(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: tetam1(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: psm1(ijb_u:ije_u)
+      REAL,INTENT(INOUT) :: massem1(ijb_u:ije_u,llm)
+      ! the tendencies to add
+      REAL,INTENT(INOUT) :: dv(ijb_v:ije_v,llm)
+      REAL,INTENT(INOUT) :: du(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: dteta(ijb_u:ije_u,llm)
+      REAL,INTENT(INOUT) :: dp(ijb_u:ije_u)
+      REAL,INTENT(INOUT) :: dq(ijb_u:ije_u,llm,nq) !!! unused
+!      REAL,INTENT(INOUT) ::finvmaold(ijb_u:ije_u,llm) !!! unused
 
 c   Local:
@@ -62,9 +71,10 @@
       REAL vscr( ijb_v:ije_v ),uscr( ijb_u:ije_u )
       REAL hscr( ijb_u:ije_u ),pscr(ijb_u:ije_u)
-      REAL massescr( ijb_u:ije_u,llm ), finvmasse(ijb_u:ije_u,llm)
+      REAL massescr( ijb_u:ije_u,llm )
+!      REAL finvmasse(ijb_u:ije_u,llm)
       REAL tpn,tps,tppn(iim),tpps(iim)
       REAL qpn,qps,qppn(iim),qpps(iim)
 
-      INTEGER  l,ij,iq
+      INTEGER  l,ij,iq,i,j
 
       REAL SSUM
@@ -74,5 +84,5 @@
       LOGICAL,SAVE :: checksum_all=.TRUE.
       INTEGER :: stop_it
-      INTEGER :: ierr,j
+      INTEGER :: ierr
 
 c-----------------------------------------------------------------------
@@ -137,8 +147,14 @@
 !     &                   MPI_LOGICAL,MPI_LOR,COMM_LMDZ,ierr)
       IF( .NOT. checksum ) THEN
-         PRINT*,' Au point ij = ',stop_it, ' , pression sol neg. '
-     &         , ps(stop_it)
-         STOP' dans integrd'
-      ENDIF
+          write(lunout,*) "integrd: negative surface pressure ",
+     &                                                ps(stop_it)
+         write(lunout,*) " at node ij =", stop_it
+         ! since ij=j+(i-1)*jjp1 , we have
+!         j=modulo(stop_it,jjp1)
+!         i=1+(stop_it-j)/jjp1
+!         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
+!     &                   " lat = ",rlatu(j)*180./pi, " deg"
+      ENDIF
+
 c$OMP END MASTER
 c$OMP BARRIER
@@ -160,5 +176,5 @@
         call WriteField_u('int_dteta',dteta)
         call WriteField_u('int_dp',dp)
-        call WriteField_u('int_finvmaold',finvmaold)
+!        call WriteField_u('int_finvmaold',finvmaold)
         do j=1,nq
           call WriteField_u('int_q'//trim(int2str(j)),
@@ -206,18 +222,20 @@
       CALL massdair_loc (     p  , masse         )
 
-c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
-      ijb=ij_begin
-      ije=ij_end
-      
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
-      DO  l = 1,llm
-        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
-      ENDDO
-c$OMP END DO NOWAIT
-
-      jjb=jj_begin
-      jje=jj_end
-      CALL filtreg_p( finvmasse,jjb_u,jje_u,jjb,jje, jjp1, llm,
-     &                -2, 2, .TRUE., 1  )
+! Ehouarn : we don't use/need finvmaold and finvmasse,
+!           so might as well not compute them
+!c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
+!      ijb=ij_begin
+!      ije=ij_end
+!      
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+!      DO  l = 1,llm
+!        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
+!      ENDDO
+!c$OMP END DO NOWAIT
+
+!      jjb=jj_begin
+!      jje=jj_end
+!      CALL filtreg_p( finvmasse,jjb_u,jje_u,jjb,jje, jjp1, llm,
+!     &                -2, 2, .TRUE., 1  )
 c
 
@@ -320,5 +338,4 @@
 
           CALL qminimum_loc( q, nq, deltap )
-	 endif ! of if (planet_type.eq."earth")
 c
 c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
@@ -371,11 +388,15 @@
       ENDIF
       
-c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
-
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
-      DO l = 1, llm      
-        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)        
-      ENDDO
-c$OMP END DO NOWAIT
+! Ehouarn: forget about finvmaold
+!c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
+
+!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+!      DO l = 1, llm      
+!        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)        
+!      ENDDO
+!c$OMP END DO NOWAIT
+
+      endif ! of if (planet_type.eq."earth")
+
 c
 c
Index: /LMDZ5/trunk/libf/dyn3dmem/leapfrog_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/leapfrog_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/leapfrog_loc.F	(revision 1673)
@@ -1,4 +1,4 @@
 ! 
-! $Id: leapfrog_p.F 1299 2010-01-20 14:27:21Z fairhead $
+! $Id$
 !
 c
@@ -119,8 +119,8 @@
 
 c   tendances physiques
-!      REAL,SAVE,ALLOCATABLE :: dvfi(:,:),dufi(:,:)
-!      REAL,SAVE,ALLOCATABLE :: dtetafi(:,:)
-!      REAL,SAVE,ALLOCATABLE :: dpfi(:)
-!      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
+      REAL,SAVE,ALLOCATABLE :: dvfi(:,:),dufi(:,:)
+      REAL,SAVE,ALLOCATABLE :: dtetafi(:,:)
+      REAL,SAVE,ALLOCATABLE :: dpfi(:)
+      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
 
 c   variables pour le fichier histoire
@@ -150,4 +150,5 @@
       REAL :: secondes
 
+      logical :: physic
       LOGICAL first,callinigrads
 
@@ -174,5 +175,5 @@
 
       character*80 dynhist_file, dynhistave_file
-      character*20 modname
+      character(len=*),parameter :: modname="leapfrog_loc"
       character*80 abort_message
 
@@ -195,5 +196,4 @@
 
       INTEGER :: true_itau
-      LOGICAL :: verbose=.true.
       INTEGER :: iapptrac
       INTEGER :: AdjustCount
@@ -215,7 +215,8 @@
       itaufin   = nday*day_step
       itaufinp1 = itaufin +1
-      modname="leapfrog_p"
 
       itau = 0
+      physic=.true.
+      if (iflag_phys==0.or.iflag_phys==2) physic=.false.
       CALL init_nan
       CALL leapfrog_allocate
@@ -252,9 +253,9 @@
 !      ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm))
 !      ALLOCATE(dtetadis(ijb_u:ije_u,llm))
-!      ALLOCATE(dvfi(ijb_v:ije_v,llm),dufi(ijb_u:ije_u,llm))
-!      ALLOCATE(dtetafi(ijb_u:ije_u,llm))
-!      ALLOCATE(dpfi(ijb_u:ije_u))
+      ALLOCATE(dvfi(ijb_v:ije_v,llm),dufi(ijb_u:ije_u,llm))
+      ALLOCATE(dtetafi(ijb_u:ije_u,llm))
+      ALLOCATE(dpfi(ijb_u:ije_u))
 !      ALLOCATE(dq(ijb_u:ije_u,llm,nqtot))
-!      ALLOCATE(dqfi(ijb_u:ije_u,llm,nqtot))
+      ALLOCATE(dqfi(ijb_u:ije_u,llm,nqtot))
 !      ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
 !      ALLOCATE(finvmaold(ijb_u:ije_u,llm))
@@ -277,9 +278,12 @@
 
 c$OMP MASTER
-      dq=0.
+      dq(:,:,:)=0.
       CALL pression ( ijnb_u, ap, bp, ps, p       )
 c$OMP END MASTER
+      if (pressure_exner) then
       CALL exner_hyb_loc( ijnb_u, ps, p,alpha,beta, pks, pk, pkf)
-
+      else 
+        CALL exner_milieu_loc( ijnb_u, ps, p, beta, pks, pk, pkf )
+      endif
 c-----------------------------------------------------------------------
 c   Debut de l'integration temporelle:
@@ -287,9 +291,15 @@
 c et du parallelisme !!
 
-   1  CONTINUE
-
-      jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec) 
-      jH_cur = jH_ref +                                                 &
-     &          (itau * dtvr / daysec - int(itau * dtvr / daysec)) 
+   1  CONTINUE ! Matsuno Forward step begins here
+
+      jD_cur = jD_ref + day_ini - day_ref +                             &
+     &          itau/day_step
+      jH_cur = jH_ref + start_time +                                    &
+     &         mod(itau,day_step)/float(day_step) 
+      if (jH_cur > 1.0 ) then
+        jD_cur = jD_cur +1.
+        jH_cur = jH_cur -1.
+      endif
+
 
 #ifdef CPP_IOIPSL
@@ -323,9 +333,10 @@
          psm1= ps
          
-         finvmaold = masse
-c$OMP END MASTER
-c$OMP BARRIER
-         CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm,
-     &                    -2,2, .TRUE., 1 )
+! Ehouarn: finvmaold is actually not used       
+!         finvmaold = masse
+c$OMP END MASTER
+c$OMP BARRIER
+!         CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm,
+!     &                    -2,2, .TRUE., 1 )
        else
 ! Save fields obtained at previous time step as '...m1'
@@ -343,5 +354,5 @@
            tetam1   (ijb:ije,l) = teta  (ijb:ije,l)
            massem1  (ijb:ije,l) = masse (ijb:ije,l)
-           finvmaold(ijb:ije,l)=masse(ijb:ije,l)
+!           finvmaold(ijb:ije,l)=masse(ijb:ije,l)
                  
            if (pole_sud) ije=ij_end-iip1
@@ -353,6 +364,7 @@
 
 
-          CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1, 
-     .                    llm, -2,2, .TRUE., 1 )
+! Ehouarn: finvmaold not used
+!          CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1, 
+!     .                    llm, -2,2, .TRUE., 1 )
 
        endif ! of if (FirstCaldyn)
@@ -370,5 +382,5 @@
 cym      call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
 
-   2  CONTINUE
+   2  CONTINUE ! Matsuno backward or leapfrog step begins here
 
 c$OMP MASTER
@@ -399,12 +411,14 @@
       ! Purely Matsuno time stepping
          IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
-         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
+         IF( MOD(itau,dissip_period ).EQ.0.AND..NOT.forward ) 
+     s        apdiss = .TRUE.
          IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 
-     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
+     s          .and. physic                        ) apphys = .TRUE.
       ELSE
       ! Leapfrog/Matsuno time stepping 
          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.iflag_phys.EQ.1) apphys=.TRUE.
+         IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward )
+     s        apdiss = .TRUE.
+         IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE.
       END IF
 
@@ -450,6 +464,6 @@
 c$OMP MASTER 
            call allgather_timer_average
-        verbose=.TRUE.
-        if (Verbose) then
+
+        if (prt_level > 9) then
         
         print *,'*********************************'
@@ -622,4 +636,5 @@
       call start_timer(timer_caldyn)
 
+      ! compute geopotential phi()
       CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
 
@@ -697,6 +712,6 @@
 
        CALL integrd_loc ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
-     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
-     $              finvmaold                                    )
+     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis)
+!     $              finvmaold                                    )
 
 !       CALL FTRACE_REGION_END("integrd")
@@ -1081,8 +1096,19 @@
 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
        do l=1,llm
-       teta(ijb:ije,l)=teta(ijb:ije,l)
-     &  -iphysiq*dtvr*(teta(ijb:ije,l)-tetarappel(ijb:ije,l))/taurappel
+       teta(ijb:ije,l)=teta(ijb:ije,l) -dtvr*
+     &        (teta(ijb:ije,l)-tetarappel(ijb:ije,l))*
+     &                 (knewt_g+knewt_t(l)*clat4(ijb:ije))        
        enddo
 !$OMP END DO
+
+!$OMP MASTER
+       if (planet_type.eq."giant") then
+         ! add an intrinsic heat flux at the base of the atmosphere
+         teta(ijb:ije,1) = teta(ijb:ije,1)
+     &        + dtvr * aire(ijb:ije) * ihf / cpp / masse(ijb:ije,1)
+       endif
+!$OMP END MASTER
+!$OMP BARRIER
+
 
        call Register_Hallo_u(ucov,llm,0,1,1,0,Request_Physic)
@@ -1092,6 +1118,37 @@
        call WaitRequest(Request_Physic)     
 c$OMP BARRIER
-       call friction_loc(ucov,vcov,iphysiq*dtvr)
+       call friction_loc(ucov,vcov,dtvr)
 !$OMP BARRIER
+
+        ! Sponge layer (if any)
+        IF (ok_strato) THEN
+          ! set dufi,dvfi,... to zero
+          ijb=ij_begin
+          ije=ij_end
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+          do l=1,llm
+            dufi(ijb:ije,l)=0
+            dtetafi(ijb:ije,l)=0
+            dqfi(ijb:ije,l,1:nqtot)=0
+          enddo
+!$OMP END DO
+!$OMP MASTER
+          dpfi(ijb:ije)=0
+!$OMP END MASTER
+          ijb=ij_begin
+          ije=ij_end
+          if (pole_sud) ije=ije-iip1
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+          do l=1,llm
+            dvfi(ijb:ije,l)=0
+          enddo
+!$OMP END DO
+
+          CALL top_bound_loc(vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
+          CALL addfi_loc( dtvr, leapf, forward   ,
+     $                  ucov, vcov, teta , q   ,ps ,
+     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
+!$OMP BARRIER
+        ENDIF ! of IF (ok_strato) 
       ENDIF ! of IF(iflag_phys.EQ.2)
 
@@ -1099,5 +1156,9 @@
         CALL pression_loc ( ip1jmp1, ap, bp, ps, p                  )
 c$OMP BARRIER
-        CALL exner_hyb_loc( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
+        if (pressure_exner) then
+        CALL exner_hyb_loc( ijnb_u, ps, p,alpha,beta, pks, pk, pkf )
+        else 
+          CALL exner_milieu_loc( ijnb_u, ps, p, beta, pks, pk, pkf )
+        endif
 c$OMP BARRIER
 
@@ -1496,9 +1557,9 @@
 c$OMP BARRIER
 
-              if (planet_type.eq."earth") then
+!              if (planet_type.eq."earth") then
 ! Write an Earth-format restart file
                 CALL dynredem1_loc("restart.nc",0.0,
      &                           vcov,ucov,teta,q,masse,ps)
-              endif ! of if (planet_type.eq."earth")
+!              endif ! of if (planet_type.eq."earth")
 
 !              CLOSE(99)
@@ -1608,8 +1669,8 @@
 
               IF(itau.EQ.itaufin) THEN
-                if (planet_type.eq."earth") then
+!                if (planet_type.eq."earth") then
                    CALL dynredem1_loc("restart.nc",0.0,
      .                               vcov,ucov,teta,q,masse,ps)
-                endif ! of if (planet_type.eq."earth")
+!               endif ! of if (planet_type.eq."earth")
               ENDIF ! of IF(itau.EQ.itaufin)
 
Index: /LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/limit_netcdf.F90	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: limit_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
+! $Id$
 !-------------------------------------------------------------------------------
 !
@@ -42,5 +42,5 @@
   REAL, DIMENSION(iip1,jjp1), INTENT(IN) :: masque   ! land mask
 #ifndef CPP_EARTH
-  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
+  CALL abort_gcm('limit_netcdf','Earth-specific routine, needs Earth physics',1)
 #else
 !-------------------------------------------------------------------------------
@@ -52,18 +52,15 @@
 #include "indicesol.h"
 
-!--- For fractionary sub-cell use (old coding used soil index: 0,1,2,3) --------
-  LOGICAL, PARAMETER :: fracterre=.TRUE.
-
 !--- INPUT NETCDF FILES NAMES --------------------------------------------------
   CHARACTER(LEN=25) :: icefile, sstfile, dumstr
   CHARACTER(LEN=25), PARAMETER :: famipsst='amipbc_sst_1x1.nc        ',        &
                                   famipsic='amipbc_sic_1x1.nc        ',        &
-                                  fclimsst='amipbc_sst_1x1_clim.nc   ',        &
-                                  fclimsic='amipbc_sic_1x1_clim.nc   ',        &
                                   fcpldsst='cpl_atm_sst.nc           ',        &
                                   fcpldsic='cpl_atm_sic.nc           ',        &
+                                  fhistsst='histmth_sst.nc           ',        &
+                                  fhistsic='histmth_sic.nc           ',        &
                                   frugo   ='Rugos.nc                 ',        &
                                   falbe   ='Albedo.nc                '
-
+  CHARACTER(LEN=10) :: varname
 !--- OUTPUT VARIABLES FOR NETCDF FILE ------------------------------------------
   REAL,   DIMENSION(klon)                :: fi_ice, verif
@@ -80,5 +77,4 @@
   INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC
   INTEGER :: NF90_FORMAT
-  LOGICAL :: lCPL                    !--- T: IPCC-IPSL cpl model output files
   INTEGER :: ndays                   !--- Depending on the output calendar
 
@@ -97,5 +93,5 @@
   kappa = 0.2857143
   cpp   = 1004.70885
-  dtvr  = daysec/FLOAT(day_step)
+  dtvr  = daysec/REAL(day_step)
   CALL inigeom
 
@@ -104,110 +100,97 @@
 
 !--- RUGOSITY TREATMENT --------------------------------------------------------
-  WRITE(lunout,*) 'Traitement de la rugosite'
-  CALL get_2Dfield(frugo,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:))
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la rugosite'
+  varname='RUGOS'
+  CALL get_2Dfield(frugo,varname,'RUG',interbar,ndays,phy_rug,mask=masque(1:iim,:))
 
 !--- OCEAN TREATMENT -----------------------------------------------------------
-  PRINT*, 'Traitement de la glace oceanique' ; icefile=''; lCPL=.FALSE.
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la glace oceanique'
 
 ! Input SIC file selection
-  icefile='fake'
-  IF(NF90_OPEN(famipsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(famipsic)
-  IF(NF90_OPEN(fclimsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(fclimsic)
-  IF(NF90_OPEN(fcpldsic,NF90_NOWRITE,nid)==NF90_NOERR) icefile=TRIM(fcpldsic)
-  SELECT CASE(icefile)
-    CASE(famipsic); dumstr='Amip.'
-    CASE(fclimsic); dumstr='Amip climatologique.'
-    CASE(fcpldsic); dumstr='de sortie du modele couplé IPSL/IPCC.';lCPL=.TRUE.
-    CASE('fake');   CALL abort_gcm('limit_netcdf','Fichier SIC non reconnu.',1)
-  END SELECT
+! Open file only to test if available
+  IF ( NF90_OPEN(TRIM(famipsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(famipsic)
+     varname='sicbcs'
+  ELSE IF( NF90_OPEN(TRIM(fcpldsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(fcpldsic)
+     varname='SIICECOV'
+  ELSE IF ( NF90_OPEN(TRIM(fhistsic),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     icefile=TRIM(fhistsic)
+     varname='pourc_sic'
+  ELSE
+     WRITE(lunout,*) 'ERROR! No sea-ice input file was found.'
+     WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsic),', ',trim(fcpldsic),', ',trim(fhistsic)
+     CALL abort_gcm('limit_netcdf','No sea-ice file was found',1)
+  END IF
   ierr=NF90_CLOSE(nid)
-  WRITE(lunout,*)'Pour la glace de mer a ete choisi un fichier '//TRIM(dumstr)
-
-  CALL get_2Dfield(icefile,'SIC',interbar,ndays,phy_ice,flag=oldice,lCPL=lCPL)
+  IF (prt_level>=0) WRITE(lunout,*)'Pour la glace de mer a ete choisi le fichier '//TRIM(icefile)
+
+  CALL get_2Dfield(icefile,varname, 'SIC',interbar,ndays,phy_ice,flag=oldice)
 
   ALLOCATE(pctsrf_t(klon,nbsrf,ndays))
   DO k=1,ndays
-    fi_ice=phy_ice(:,k)
-    WHERE(fi_ice>=1.0  ) fi_ice=1.0
-    WHERE(fi_ice<EPSFRA) fi_ice=0.0
-    IF(fracterre) THEN
-      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
-      pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
-      IF(lCPL) THEN                               ! SIC=pICE*(1-LIC-TER)
-        pctsrf_t(:,is_sic,k)=fi_ice*(1-pctsrf(:,is_lic)-pctsrf(:,is_ter))
-      ELSE                                        ! SIC=pICE-LIC
+     fi_ice=phy_ice(:,k)
+     WHERE(fi_ice>=1.0  ) fi_ice=1.0
+     WHERE(fi_ice<EPSFRA) fi_ice=0.0
+     pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)       ! land soil
+     pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic)       ! land ice
+     IF (icefile==trim(fcpldsic)) THEN           ! SIC=pICE*(1-LIC-TER)
+        pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter))
+     ELSE IF (icefile==trim(fhistsic)) THEN      ! SIC=pICE
+        pctsrf_t(:,is_sic,k)=fi_ice(:)
+     ELSE ! icefile==famipsic                    ! SIC=pICE-LIC
         pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k)
-      END IF
-      WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
-      WHERE(1.0-zmasq<EPSFRA)
+     END IF
+     WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0.
+     WHERE(1.0-zmasq<EPSFRA)
         pctsrf_t(:,is_sic,k)=0.0
         pctsrf_t(:,is_oce,k)=0.0
-      ELSEWHERE
+     ELSEWHERE
         WHERE(pctsrf_t(:,is_sic,k)>=1.0-zmasq)
-          pctsrf_t(:,is_sic,k)=1.0-zmasq
-          pctsrf_t(:,is_oce,k)=0.0
+           pctsrf_t(:,is_sic,k)=1.0-zmasq
+           pctsrf_t(:,is_oce,k)=0.0
         ELSEWHERE
-          pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
-          WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
-            pctsrf_t(:,is_oce,k)=0.0
-            pctsrf_t(:,is_sic,k)=1.0-zmasq
-          END WHERE
+           pctsrf_t(:,is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)
+           WHERE(pctsrf_t(:,is_oce,k)<EPSFRA)
+              pctsrf_t(:,is_oce,k)=0.0
+              pctsrf_t(:,is_sic,k)=1.0-zmasq
+           END WHERE
         END WHERE
-      END WHERE
-      nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
-      nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
-    ELSE 
-      pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter)
-      WHERE(NINT(pctsrf(:,is_ter))==1)
-        pctsrf_t(:,is_sic,k)=0.
-        pctsrf_t(:,is_oce,k)=0.                  
-        WHERE(fi_ice>=1.e-5)
-          pctsrf_t(:,is_lic,k)=fi_ice
-          pctsrf_t(:,is_ter,k)=pctsrf_t(:,is_ter,k)-pctsrf_t(:,is_lic,k)
-        ELSEWHERE
-          pctsrf_t(:,is_lic,k)=0.0
-        END WHERE
-      ELSEWHERE
-        pctsrf_t(:,is_lic,k) = 0.0 
-        WHERE(fi_ice>=1.e-5)
-          pctsrf_t(:,is_ter,k)=0.0
-          pctsrf_t(:,is_sic,k)=fi_ice
-          pctsrf_t(:,is_oce,k)=1.0-pctsrf_t(:,is_sic,k)
-        ELSEWHERE
-          pctsrf_t(:,is_sic,k)=0.0
-          pctsrf_t(:,is_oce,k)=1.0
-        END WHERE
-      END WHERE
-      verif=sum(pctsrf_t(:,:,k),dim=2)
-      nbad=COUNT(verif<1.0-1.e-5.OR.verif>1.0+1.e-5)
-      IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
-    END IF 
+     END WHERE
+     nbad=COUNT(pctsrf_t(:,is_oce,k)<0.0)
+     IF(nbad>0) WRITE(lunout,*) 'pb sous maille pour nb point = ',nbad
+     nbad=COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)
+     IF(nbad>0) WRITE(lunout,*) 'pb sous surface pour nb points = ',nbad
   END DO
   DEALLOCATE(phy_ice)
 
 !--- SST TREATMENT -------------------------------------------------------------
-  WRITE(lunout,*) 'Traitement de la sst' ; sstfile=''; lCPL=.FALSE.
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de la sst'
 
 ! Input SST file selection
-  sstfile='fake'
-  IF(NF90_OPEN(famipsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(famipsst)
-  IF(NF90_OPEN(fclimsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(fclimsst)
-  IF(NF90_OPEN(fcpldsst,NF90_NOWRITE,nid)==NF90_NOERR) sstfile=TRIM(fcpldsst)
-  SELECT CASE(icefile)
-    CASE(famipsic); dumstr='Amip.'
-    CASE(fclimsic); dumstr='Amip climatologique.'
-    CASE(fcpldsic); dumstr='de sortie du modele couplé IPSL/IPCC.';lCPL=.TRUE.
-    CASE('fake');   CALL abort_gcm('limit_netcdf','Fichier SST non reconnu',1)
-  END SELECT
+! Open file only to test if available
+  IF ( NF90_OPEN(TRIM(famipsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(famipsst)
+     varname='tosbcs'
+  ELSE IF ( NF90_OPEN(TRIM(fcpldsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(fcpldsst)
+     varname='SISUTESW'
+  ELSE IF ( NF90_OPEN(TRIM(fhistsst),NF90_NOWRITE,nid)==NF90_NOERR ) THEN
+     sstfile=TRIM(fhistsst)
+     varname='tsol_oce'
+  ELSE
+     WRITE(lunout,*) 'ERROR! No sst input file was found.'
+     WRITE(lunout,*) 'One of following files must be availible : ',trim(famipsst),trim(fcpldsst),trim(fhistsst)
+     CALL abort_gcm('limit_netcdf','No sst file was found',1)
+  END IF
   ierr=NF90_CLOSE(nid)
-  WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(dumstr)
-
-  CALL get_2Dfield(trim(sstfile),'SST',interbar,ndays,phy_sst,flag=extrap)
+  IF (prt_level>=0) WRITE(lunout,*)'Pour la temperature de mer a ete choisi un fichier '//TRIM(sstfile)
+
+  CALL get_2Dfield(sstfile,varname,'SST',interbar,ndays,phy_sst,flag=extrap)
 
 !--- ALBEDO TREATMENT ----------------------------------------------------------
-  WRITE(lunout,*) 'Traitement de l albedo'
-  CALL get_2Dfield(falbe,'ALB',interbar,ndays,phy_alb)
+  IF (prt_level>1) WRITE(lunout,*) 'Traitement de l albedo'
+  varname='ALBEDO'
+  CALL get_2Dfield(falbe,varname,'ALB',interbar,ndays,phy_alb)
 
 !--- REFERENCE GROUND HEAT FLUX TREATMENT --------------------------------------
@@ -215,5 +198,5 @@
 
 !--- OUTPUT FILE WRITING -------------------------------------------------------
-  WRITE(lunout,*) 'Ecriture du fichier limit'
+  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : debut'
 
   !--- File creation
@@ -264,7 +247,7 @@
   ierr=NF90_CLOSE(nid)
 
+  IF (prt_level>5) WRITE(lunout,*) 'Ecriture du fichier limit : fin'
+
   DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
-#endif
-! of #ifdef CPP_EARTH
 
 
@@ -278,5 +261,5 @@
 !-------------------------------------------------------------------------------
 !
-SUBROUTINE get_2Dfield(fnam, mode, ibar, ndays, champo, flag, mask, lCPL)
+SUBROUTINE get_2Dfield(fnam, varname, mode, ibar, ndays, champo, flag, mask)
 !
 !-----------------------------------------------------------------------------
@@ -306,11 +289,11 @@
 ! Arguments:
   CHARACTER(LEN=*),  INTENT(IN)     :: fnam     ! NetCDF file name
+  CHARACTER(LEN=10), INTENT(IN)     :: varname  ! NetCDF variable name
   CHARACTER(LEN=3),  INTENT(IN)     :: mode     ! RUG, SIC, SST or ALB
   LOGICAL,           INTENT(IN)     :: ibar     ! interp on pressure levels
   INTEGER,           INTENT(IN)     :: ndays    ! current year number of days
-  REAL,    POINTER,  DIMENSION(:, :) :: champo   ! output field = f(t)
+  REAL,    POINTER,  DIMENSION(:, :) :: champo  ! output field = f(t)
   LOGICAL, OPTIONAL, INTENT(IN)     :: flag     ! extrapol. (SST) old ice (SIC)
   REAL,    OPTIONAL, DIMENSION(iim, jjp1), INTENT(IN) :: mask
-  LOGICAL, OPTIONAL, INTENT(IN)     :: lCPL     ! Coupled model flag (for ICE)
 !------------------------------------------------------------------------------
 ! Local variables:
@@ -318,5 +301,4 @@
   INTEGER :: ncid, varid                  ! NetCDF identifiers
   CHARACTER(LEN=30)               :: dnam       ! dimension name
-  CHARACTER(LEN=80)               :: varname    ! NetCDF variable name
 !--- dimensions
   INTEGER,           DIMENSION(4) :: dids       ! NetCDF dimensions identifiers
@@ -333,4 +315,5 @@
 !--- input files
   CHARACTER(LEN=20)                 :: cal_in   ! calendar
+  CHARACTER(LEN=20)                 :: unit_sic ! attribute unit in sea-ice file
   INTEGER                           :: ndays_in ! number of days
 !--- misc
@@ -339,26 +322,45 @@
   CHARACTER(LEN=25)                 :: title    ! for messages
   LOGICAL                           :: extrp    ! flag for extrapolation
+  LOGICAL                           :: oldice   ! flag for old way ice computation 
   REAL                              :: chmin, chmax
   INTEGER ierr
   integer n_extrap ! number of extrapolated points
   logical skip
+
 !------------------------------------------------------------------------------
 !---Variables depending on keyword 'mode' -------------------------------------
   NULLIFY(champo)
+
   SELECT CASE(mode)
-    CASE('RUG'); varname='RUGOS';  title='Rugosite'
-    CASE('SIC'); varname='sicbcs'; title='Sea-ice'
-    CASE('SST'); varname='tosbcs'; title='SST'
-    CASE('ALB'); varname='ALBEDO'; title='Albedo'
+  CASE('RUG'); title='Rugosite'
+  CASE('SIC'); title='Sea-ice'
+  CASE('SST'); title='SST'
+  CASE('ALB'); title='Albedo'
   END SELECT
+  
+
   extrp=.FALSE. 
+  oldice=.FALSE.
   IF ( PRESENT(flag) ) THEN 
     IF ( flag .AND. mode=='SST' ) extrp=.TRUE. 
+    IF ( flag .AND. mode=='SIC' ) oldice=.TRUE. 
   END IF
 
 !--- GETTING SOME DIMENSIONAL VARIABLES FROM FILE -----------------------------
+  IF (prt_level>5) WRITE(lunout,*) ' Now reading file : ',fnam
   ierr=NF90_OPEN(fnam, NF90_NOWRITE, ncid);             CALL ncerr(ierr, fnam)
-  ierr=NF90_INQ_VARID(ncid, varname, varid);            CALL ncerr(ierr, fnam)
+  ierr=NF90_INQ_VARID(ncid, trim(varname), varid);            CALL ncerr(ierr, fnam)
   ierr=NF90_INQUIRE_VARIABLE(ncid, varid, dimids=dids); CALL ncerr(ierr, fnam)
+
+!--- Read unit for sea-ice variable only
+  IF (mode=='SIC') THEN
+     ierr=NF90_GET_ATT(ncid, varid, 'units', unit_sic)
+     IF(ierr/=NF90_NOERR) THEN
+        IF (prt_level>5) WRITE(lunout,*) 'No unit was given in sea-ice file. Take percentage as default value'
+        unit_sic='X'
+     ELSE
+        IF (prt_level>5) WRITE(lunout,*) ' Sea-ice cover has unit=',unit_sic
+     END IF
+  END IF
 
 !--- Longitude
@@ -367,5 +369,5 @@
   ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
   ierr=NF90_GET_VAR(ncid, varid, dlon_ini);              CALL ncerr(ierr, fnam)
-  WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
+  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', imdep
 
 !--- Latitude
@@ -374,5 +376,5 @@
   ierr=NF90_INQ_VARID(ncid, dnam, varid);                CALL ncerr(ierr, fnam)
   ierr=NF90_GET_VAR(ncid, varid, dlat_ini);              CALL ncerr(ierr, fnam)
-  WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
+  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', jmdep
 
 !--- Time (variable is not needed - it is rebuilt - but calendar is)
@@ -387,10 +389,11 @@
       CASE('SIC', 'SST'); cal_in='gregorian'
     END SELECT
-    WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
+    IF (prt_level>5) WRITE(lunout, *)'ATTENTION: variable "time" sans attribut "calendrier" ' &
          // 'dans '//TRIM(fnam)//'. On choisit la valeur par defaut.'
   END IF
-  WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
+  IF (prt_level>5) WRITE(lunout, *) 'variable ', dnam, 'dimension ', lmdep, 'calendrier ', &
        cal_in
 
+  
 !--- CONSTRUCTING THE INPUT TIME VECTOR FOR INTERPOLATION --------------------
   !--- Determining input file number of days, depending on calendar
@@ -400,7 +403,6 @@
 !--- If input records are not monthly, time sampling has to be constant !
   timeyear=mid_months(anneeref, cal_in, lmdep)
-  IF (lmdep /= 12) WRITE(lunout, '(a, i3, a)') 'Note : les fichiers de ' &
-       // TRIM(mode) // ' ne comportent pas 12, mais ', lmdep, &
-       ' enregistrements.'
+  IF (lmdep /= 12) WRITE(lunout,*) 'Note : les fichiers de ', TRIM(mode), &
+       ' ne comportent pas 12, mais ', lmdep, ' enregistrements.'
 
 !--- GETTING THE FIELD AND INTERPOLATING IT ----------------------------------
@@ -408,7 +410,6 @@
   IF(extrp) ALLOCATE(work(imdep, jmdep))
 
-  WRITE(lunout, *)
-  WRITE(lunout, '(a, i3, a)')'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, &
-       ' CHAMPS.'
+  IF (prt_level>5) WRITE(lunout, *)
+  IF (prt_level>5) WRITE(lunout,*)'LECTURE ET INTERPOLATION HORIZ. DE ', lmdep, ' CHAMPS.'
   ierr=NF90_INQ_VARID(ncid, varname, varid);             CALL ncerr(ierr, fnam)
   DO l=1, lmdep
@@ -421,12 +422,9 @@
          work)
 
-    IF(ibar.AND..NOT.(mode=='SIC'.AND.flag)) THEN
-      IF(l==1) THEN
-        WRITE(lunout, *)                                                      &
-  '-------------------------------------------------------------------------'
-        WRITE(lunout, *)                                                     &
-  'Utilisation de l''interpolation barycentrique pour '//TRIM(title)//' $$$'
-        WRITE(lunout, *)                                                      &
-  '-------------------------------------------------------------------------'
+    IF(ibar .AND. .NOT.oldice) THEN
+      IF(l==1 .AND. prt_level>5) THEN
+        WRITE(lunout, *) '-------------------------------------------------------------------------'
+        WRITE(lunout, *) 'Utilisation de l''interpolation barycentrique pour ',TRIM(title),' $$$'
+        WRITE(lunout, *) '-------------------------------------------------------------------------'
       END IF
       IF(mode=='RUG') champ=LOG(champ)
@@ -455,8 +453,11 @@
 
 !--- TIME INTERPOLATION ------------------------------------------------------
-  WRITE(lunout, *)
-  WRITE(lunout, *)'INTERPOLATION TEMPORELLE.'
-  WRITE(lunout, "(2x, ' Vecteur temps en entree: ', 10f6.1)") timeyear
-  WRITE(lunout, "(2x, ' Vecteur temps en sortie de 0 a ', i3)") ndays
+  IF (prt_level>5) THEN
+     WRITE(lunout, *)
+     WRITE(lunout, *)'INTERPOLATION TEMPORELLE.'
+     WRITE(lunout, *)' Vecteur temps en entree: ', timeyear
+     WRITE(lunout, *)' Vecteur temps en sortie de 0 a ', ndays
+  END IF
+
   ALLOCATE(yder(lmdep), champan(iip1, jjp1, ndays))
   skip = .false.
@@ -473,5 +474,5 @@
   END DO
   if (n_extrap /= 0) then
-     print *, "get_2Dfield pchfe_95: n_extrap = ", n_extrap
+     WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap
   end if
   champan(iip1, :, :)=champan(1, :, :)
@@ -481,10 +482,10 @@
   DO j=1, jjp1
     CALL minmax(iip1, champan(1, j, 10), chmin, chmax)
-    WRITE(lunout, *)' '//TRIM(title)//' au temps 10 ', chmin, chmax, j
+    IF (prt_level>5) WRITE(lunout, *)' ',TRIM(title),' au temps 10 ', chmin, chmax, j
   END DO
 
 !--- SPECIAL FILTER FOR SST: SST>271.38 --------------------------------------
   IF(mode=='SST') THEN
-    WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'
+    IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SST: SST >= 271.38'
     WHERE(champan<271.38) champan=271.38
   END IF
@@ -492,10 +493,20 @@
 !--- SPECIAL FILTER FOR SIC: 0.0<SIC<1.0 -------------------------------------
   IF(mode=='SIC') THEN
-    WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0'
-    IF(.NOT.lCPL) champan(:, :, :)=champan(:, :, :)/100.
+    IF (prt_level>5) WRITE(lunout, *) 'Filtrage de la SIC: 0.0 < Sea-ice < 1.0'
+
+    IF (unit_sic=='1') THEN
+       ! Nothing to be done for sea-ice field is already in fraction of 1
+       ! This is the case for sea-ice in file cpl_atm_sic.nc
+       IF (prt_level>5) WRITE(lunout,*) 'Sea-ice field already in fraction of 1'
+    ELSE
+       ! Convert sea ice from percentage to fraction of 1
+       IF (prt_level>5) WRITE(lunout,*) 'Transformt sea-ice field from percentage to fraction of 1.' 
+       champan(:, :, :)=champan(:, :, :)/100.
+    END IF
+
     champan(iip1, :, :)=champan(1, :, :)
     WHERE(champan>1.0) champan=1.0
     WHERE(champan<0.0) champan=0.0
-  END IF
+ END IF
 
 !--- DYNAMICAL TO PHYSICAL GRID ----------------------------------------------
@@ -592,7 +603,7 @@
 
 !--- Mid-months times
-  mid_months(1)=0.5*FLOAT(mnth(1))
+  mid_months(1)=0.5*REAL(mnth(1))
   DO k=2,nm
-    mid_months(k)=mid_months(k-1)+0.5*FLOAT(mnth(k-1)+mnth(k))
+    mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
   END DO
 
@@ -626,4 +637,6 @@
 !-------------------------------------------------------------------------------
 
+#endif
+! of #ifdef CPP_EARTH
 
 END SUBROUTINE limit_netcdf
Index: /LMDZ5/trunk/libf/dyn3dmem/limy.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/limy.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/limy.F	(revision 1673)
@@ -1,5 +1,5 @@
-!
-! $Header$
-!
+c
+c $Id$
+c
       SUBROUTINE limy(s0,sy,sm,pente_max)
 c
@@ -40,5 +40,5 @@
       REAL qbyv(ip1jm,llm)
 
-      REAL qpns,qpsn,apn,aps,dyn1,dys1,dyn2,dys2
+      REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2
       Logical extremum,first
       save first
@@ -52,5 +52,6 @@
       REAL      SSUM
       integer ismax,ismin
-      EXTERNAL  SSUM, ismin,ismax
+      EXTERNAL  SSUM, convflu,ismin,ismax
+      EXTERNAL filtreg
 
       data first/.true./
@@ -116,14 +117,14 @@
 
 c     print*,dyqv(iip1+1)
-c     apn=abs(dyq(1)/dyqv(iip1+1))
+c     appn=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     apps=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        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
+c        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
 c     enddo
-c     apn=min(pente_max/apn,1.)
-c     aps=min(pente_max/aps,1.)
+c     appn=min(pente_max/appn,1.)
+c     apps=min(pente_max/apps,1.)
 
 
@@ -131,13 +132,13 @@
 
 c     if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-c    &   apn=0.
+c    &   appn=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    &   apps=0.
 
 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        dyq(ij)=appn*dyq(ij)
+c        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
 c     enddo
 
Index: /LMDZ5/trunk/libf/dyn3dmem/logic.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/logic.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/logic.h	(revision 1673)
@@ -1,21 +1,27 @@
 !
-! $Id: logic.h 1319 2010-02-23 21:29:54Z fairhead $
+! $Id$
 !
 !
-!
+! NB: keep items of different kinds in seperate common blocs to avoid
+!     "misaligned commons" issues
 !-----------------------------------------------------------------------
 ! INCLUDE 'logic.h'
 
-      COMMON/logic/ purmats,iflag_phys,forward,leapf,apphys,            &
+      COMMON/logicl/ purmats,forward,leapf,apphys,                      &
      &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
      &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
-     &  ,ok_limit,ok_etat0
+     &  ,ok_limit,ok_etat0,grilles_gcm_netcdf,hybrid
 
+      COMMON/logici/ iflag_phys,iflag_trac
+      
       LOGICAL purmats,forward,leapf,apphys,statcl,conser,               &
      & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
      &  ,read_start,ok_guide,ok_strato,ok_gradsfile                     &
-     &  ,ok_limit,ok_etat0
+     &  ,ok_limit,ok_etat0,grilles_gcm_netcdf
+      logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
+                     ! (only used if disvert_type==2)
 
-      INTEGER iflag_phys
-!$OMP THREADPRIVATE(/logic/)
+      integer iflag_phys,iflag_trac
+!$OMP THREADPRIVATE(/logicl/)
+!$OMP THREADPRIVATE(/logici/)
 !-----------------------------------------------------------------------
Index: /LMDZ5/trunk/libf/dyn3dmem/mod_interface_dyn_phys.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/mod_interface_dyn_phys.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/mod_interface_dyn_phys.F90	(revision 1673)
@@ -1,4 +1,4 @@
 ! 
-! $Id: mod_interface_dyn_phys.F90 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
 MODULE mod_interface_dyn_phys
@@ -7,7 +7,6 @@
   
   
-#ifdef CPP_EARTH
+#ifdef CPP_PHYS
 ! Interface with parallel physics,
-! for now this routine only works with Earth physics
 CONTAINS
   
@@ -56,4 +55,4 @@
   END SUBROUTINE Init_interface_dyn_phys 
 #endif
-! of #ifdef CPP_EARTH
+! of #ifdef CPP_PHYS
 END MODULE mod_interface_dyn_phys
Index: /LMDZ5/trunk/libf/dyn3dmem/parallel.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/parallel.F90	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/parallel.F90	(revision 1673)
@@ -1,4 +1,4 @@
 ! 
-! $Id: parallel.F90 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
   module parallel
@@ -94,5 +94,7 @@
       integer, dimension(3) :: blocklen,type
       integer :: comp_id
-
+      character(len=4)  :: num
+      character(len=20) :: filename
+ 
 #ifdef CPP_OMP    
       INTEGER :: OMP_GET_NUM_THREADS
@@ -126,5 +128,16 @@
         mpi_rank=0
       ENDIF
-  
+
+
+! Open text output file with mpi_rank in suffix of file name 
+      IF (lunout /= 5 .and. lunout /= 6) THEN
+         WRITE(num,'(I4.4)') mpi_rank
+         filename='lmdz.out_'//num
+         IF (mpi_rank .NE. 0) THEN
+            OPEN(UNIT=lunout,FILE=TRIM(filename),ACTION='write', &
+               STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
+         ENDIF
+      ENDIF
+
       
       allocate(jj_begin_para(0:mpi_size-1))
@@ -376,7 +389,8 @@
       integer :: ierr
       integer :: i
-      deallocate(jj_begin_para)
-      deallocate(jj_end_para)
-      deallocate(jj_nb_para)
+
+      if (allocated(jj_begin_para)) deallocate(jj_begin_para)
+      if (allocated(jj_end_para))   deallocate(jj_end_para)
+      if (allocated(jj_nb_para))    deallocate(jj_nb_para)
 
       if (type_ocean == 'couple') then
@@ -717,23 +731,22 @@
         
    
-    /*  
-  Subroutine verif_hallo(Field,ij,ll,up,down)
-    implicit none
-#include "dimensions.h"
-#include "paramet.h"    
-    include 'mpif.h'
-    
-      INTEGER :: ij,ll
-      REAL, dimension(ij,ll) :: Field
-      INTEGER :: up,down 
-      
-      REAL,dimension(ij,ll): NewField
-      
-      NewField=0
-      
-      ijb=ij_begin
-      ije=ij_end
-      if (pole_nord) 
-      NewField(ij_be       
-*/
+!  Subroutine verif_hallo(Field,ij,ll,up,down)
+!    implicit none
+!#include "dimensions.h"
+!#include "paramet.h"    
+!    include 'mpif.h'
+!    
+!      INTEGER :: ij,ll
+!      REAL, dimension(ij,ll) :: Field
+!      INTEGER :: up,down 
+!      
+!      REAL,dimension(ij,ll): NewField
+!      
+!      NewField=0
+!      
+!      ijb=ij_begin
+!      ije=ij_end
+!      if (pole_nord) 
+!      NewField(ij_be       
+
   end module parallel
Index: /LMDZ5/trunk/libf/dyn3dmem/paramet.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/paramet.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/paramet.h	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Header$
+! $Id$
 !
 !
Index: /LMDZ5/trunk/libf/dyn3dmem/temps.h
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/temps.h	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/temps.h	(revision 1673)
@@ -1,4 +1,4 @@
 !
-! $Id: temps.h 1279 2009-12-10 09:02:56Z fairhead $
+! $Id$
 !
 !  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
@@ -14,10 +14,12 @@
 
       COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
-     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend
+     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
+     &             start_time
+
 
       INTEGER   itaufin
       INTEGER itau_dyn, itau_phy
       INTEGER day_ini, day_end, annee_ref, day_ref
-      REAL      dt, jD_ref, jH_ref
+      REAL      dt, jD_ref, jH_ref, start_time
       CHARACTER (len=10) :: calend
 
Index: DZ5/trunk/libf/dyn3dmem/ugeostr.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/ugeostr.F	(revision 1672)
+++ 	(revision )
@@ -1,69 +1,0 @@
-!
-! $Id: ugeostr.F 1403 2010-07-01 09:02:53Z fairhead $
-!
-      subroutine ugeostr(phi,ucov)
-
-
-c  Calcul du vent covariant geostrophique a partir du champs de
-c  geopotentiel en supposant que le vent au sol est nul.
-
-      implicit none
-
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom2.h"
-
-      real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
-      real um(jjm,llm),fact,u(iip1,jjm,llm)
-      integer i,j,l
-
-      real zlat
-
-      um(:,:)=0 ! initialize um()
-
-      DO j=1,jjm
-
-         if (abs(sin(rlatv(j))).lt.1.e-4) then
-             zlat=1.e-4
-         else
-             zlat=rlatv(j)
-         endif
-         fact=cos(zlat)
-         fact=fact*fact
-         fact=fact*fact
-         fact=fact*fact
-         fact=(1.-fact)/
-     s    (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
-         fact=-fact/rad
-         DO l=1,llm
-            DO i=1,iim
-               u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
-               um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
-            ENDDO
-         ENDDO
-      ENDDO
-      call dump2d(jjm,llm,um,'Vent-u geostrophique')
-
-c
-c-----------------------------------------------------------------------
-c   calcul des champ de vent:
-c   -------------------------
-
-      DO 301 l=1,llm
-         DO 302 i=1,iip1
-            ucov(i,1,l)=0.
-            ucov(i,jjp1,l)=0.
-302      CONTINUE
-         DO 304 j=2,jjm
-            DO 305 i=1,iim
-               ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
-305         CONTINUE
-            ucov(iip1,j,l)=ucov(1,j,l)
-304      CONTINUE
-301   CONTINUE
-
-      print*,301
-
-      return
-      end
Index: /LMDZ5/trunk/libf/dyn3dmem/ugeostr.F90
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/ugeostr.F90	(revision 1673)
+++ /LMDZ5/trunk/libf/dyn3dmem/ugeostr.F90	(revision 1673)
@@ -0,0 +1,68 @@
+!
+! $Id: ugeostr.F90 1492 2011-03-08 08:10:25Z fairhead $
+!
+subroutine ugeostr(phi,ucov)
+
+  ! Calcul du vent covariant geostrophique a partir du champ de
+  ! geopotentiel.
+  ! We actually compute: (1 - cos^8 \phi) u_g
+  ! to have a wind going smoothly to 0 at the equator.
+  ! We assume that the surface pressure is uniform so that model
+  ! levels are pressure levels.
+
+  implicit none
+
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comgeom2.h"
+
+  real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
+  real um(jjm,llm),fact,u(iip1,jjm,llm)
+  integer i,j,l
+
+  real zlat
+
+  um(:,:)=0 ! initialize um()
+
+  DO j=1,jjm
+
+     if (abs(sin(rlatv(j))).lt.1.e-4) then
+        zlat=1.e-4
+     else
+        zlat=rlatv(j)
+     endif
+     fact=cos(zlat)
+     fact=fact*fact
+     fact=fact*fact
+     fact=fact*fact
+     fact=(1.-fact)/ &
+          (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j)))
+     fact=-fact/rad
+     DO l=1,llm
+        DO i=1,iim
+           u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l))
+           um(j,l)=um(j,l)+u(i,j,l)/REAL(iim)
+        ENDDO
+     ENDDO
+  ENDDO
+  call dump2d(jjm,llm,um,'Vent-u geostrophique')
+
+  !   calcul des champ de vent:
+
+  DO l=1,llm
+     DO i=1,iip1
+        ucov(i,1,l)=0.
+        ucov(i,jjp1,l)=0.
+     end DO
+     DO  j=2,jjm
+        DO  i=1,iim
+           ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j)
+        end DO
+        ucov(iip1,j,l)=ucov(1,j,l)
+     end DO
+  end DO
+
+  print *, 301
+
+end subroutine ugeostr
Index: /LMDZ5/trunk/libf/dyn3dmem/vlsplt_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/vlsplt_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/vlsplt_loc.F	(revision 1673)
@@ -1,2 +1,5 @@
+!
+! $Id$
+!
       SUBROUTINE vlx_loc(q,pente_max,masse,u_m,ijb_x,ije_x)
 
@@ -372,5 +375,5 @@
       REAL qbyv(ijb_v:ije_v,llm)
 
-      REAL qpns,qpsn,apn,aps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
+      REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
 c     REAL newq,oldmasse
       Logical extremum,first,testcpu
@@ -543,14 +546,14 @@
 C     PRINT*,dyq(1)
 C     PRINT*,dyqv(iip1+1)
-C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     appn=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     apps=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        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
+C        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
 C     ENDDO
-C     apn=min(pente_max/apn,1.)
-C     aps=min(pente_max/aps,1.)
+C     appn=min(pente_max/appn,1.)
+C     apps=min(pente_max/apps,1.)
 C
 C
@@ -558,13 +561,13 @@
 C
 C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-C    &   apn=0.
+C    &   appn=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    &   apps=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        dyq(ij)=appn*dyq(ij)
+C        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
 C     ENDDO
 C
Index: /LMDZ5/trunk/libf/dyn3dmem/vlspltqs_loc.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/vlspltqs_loc.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/vlspltqs_loc.F	(revision 1673)
@@ -549,14 +549,14 @@
 C     PRINT*,dyq(1)
 C     PRINT*,dyqv(iip1+1)
-C     apn=abs(dyq(1)/dyqv(iip1+1))
+C     appn=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     apps=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        appn=amax1(abs(dyq(ij)/dyqv(ij)),appn)
+C        apps=amax1(abs(dyq(ip1jm+ij)/dyqv(ip1jm-iip1+ij)),apps)
 C     ENDDO
-C     apn=min(pente_max/apn,1.)
-C     aps=min(pente_max/aps,1.)
+C     appn=min(pente_max/appn,1.)
+C     apps=min(pente_max/apps,1.)
 C
 C
@@ -564,13 +564,13 @@
 C
 C     IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
-C    &   apn=0.
+C    &   appn=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    &   apps=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        dyq(ij)=appn*dyq(ij)
+C        dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
 C     ENDDO
 C
Index: /LMDZ5/trunk/libf/dyn3dmem/wrgrads.F
===================================================================
--- /LMDZ5/trunk/libf/dyn3dmem/wrgrads.F	(revision 1672)
+++ /LMDZ5/trunk/libf/dyn3dmem/wrgrads.F	(revision 1673)
@@ -22,5 +22,5 @@
 c   local
 
-      integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
+      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
 
       logical writectl
@@ -55,5 +55,5 @@
             nvar(if)=ivar(if)
             var(ivar(if),if)=name
-            tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
+            tvar(ivar(if),if)=trim(titlevar)
             nld(ivar(if),if)=nl
             print*,'initialisation ecriture de ',var(ivar(if),if)
@@ -96,8 +96,8 @@
       file=fichier(if)
 c   WARNING! on reecrase le fichier .ctl a chaque ecriture
-      open(unit(if),file=file(1:lnblnk(file))//'.ctl'
+      open(unit(if),file=trim(file)//'.ctl'
      &         ,form='formatted',status='unknown')
       write(unit(if),'(a5,1x,a40)')
-     &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
+     &       'DSET ','^'//trim(file)//'.dat'
 
       write(unit(if),'(a12)') 'UNDEF 1.0E30'
