Index: trunk/LMDZ.TITAN/libf/phytitan/YOEGWD.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/YOEGWD.h	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/YOEGWD.h	(revision 1056)
@@ -0,0 +1,10 @@
+!     -----------------------------------------------------------------
+!*    *COMMON* *YOEGWD* - PARAMETERS FOR GRAVITY WAVE DRAG CALCULATIONS
+!     -----------------------------------------------------------------
+!
+      integer :: NKTOPG,NTOP
+      real    :: GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT
+      real    :: GHMAX,GRAHILO,GSIGCR,GSSEC,GTSEC,GVSEC
+      COMMON/YOEGWD/ GFRCRIT,GKWAKE,GRCRIT,GVCRIT,GKDRAG,GKLIFT         &
+     &   ,GHMAX,GRAHILO,GSIGCR,NKTOPG,NTOP,GSSEC,GTSEC,GVSEC
+
Index: trunk/LMDZ.TITAN/libf/phytitan/aerprod.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/aerprod.h	(revision 1055)
+++ 	(revision )
@@ -1,20 +1,0 @@
-c-----------------------------------------------------------------------
-c INCLUDE 'aerprod.h
-
-      COMMON/aerprod/utilaer,maer,prodaer,csn,csh
-      COMMON/htoh2/psurfhaze
-
-      integer utilaer(16)
-
-c 1: melange (prodaer,csn,csh) / 2: polyC2H2 / 3: PAHs / 4: polyHCN
-c maer:    en g mol-1, masse molaire moyenne
-c prodaer: en kg m-3 s-1, mass production rates
-
-      real  maer(ip1jmp1,llm,4),prodaer(ip1jmp1,llm,4)
-      real  csn(ip1jmp1,llm,4),csh(ip1jmp1,llm,4)
-
-c for H-> H2
-      real  psurfhaze(ip1jmp1,llm) ! total area of haze particles (um2/cm3)
-
-c-----------------------------------------------------------------------
-
Index: trunk/LMDZ.TITAN/libf/phytitan/brume3D.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/brume3D.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/brume3D.F	(revision 1056)
@@ -50,5 +50,5 @@
          integer xnz,xnrad,ngrid
          integer li,lf,ihor
-         real dt
+         real dt,g
          real c0(nz,nrad),c(nz,nrad,2)
          real k(nz,nrad,nrad),knu
@@ -72,21 +72,4 @@
          data itime/0/
 
-* initialisation
-* --------------
-
-* effet saisonnier
-* ----------------
-
-
-         xsaison=0.
-         xsaison=pmu0*4.*pfract
-                              !=Pi si fract=1/2 (equinoxe) et 
-                              !    si mu0(ihor)=1 sous le soleil
-                              !    exactement.
-
-c        xsaison=0.
-c        if (ihor.le.9.or.ihor.ge.41) xsaison=8.  ! rapport des surfaces
-c        xsaison=1.
-
 * controles
 * ---------
@@ -104,15 +87,36 @@
          dt=x1 
 
-         if (itime.eq.0) then 
-           ITIME=1
+* initialisation unique
+* --------------
+
+c         if (itime.eq.0) then 
+c           ITIME=1
+c         endif
+
+* initialisation
+* --------------
+
            call init
            call calcoag
-         endif
+
+* effet saisonnier
+* ----------------
+
+
+         xsaison=0.
+         xsaison=pmu0*4.*pfract
+                              !=Pi si fract=1/2 (equinoxe) et 
+                              !    si mu0(ihor)=1 sous le soleil
+                              !    exactement.
+
+c        xsaison=0.
+c        if (ihor.le.9.or.ihor.ge.41) xsaison=8.  ! rapport des surfaces
+c        xsaison=1.
 
          do i=1,nz,1
            do j=1,nrad
              v1=vitesse(i,j,0)
-c             ho que c'est moche ! -> taused = RT/(Mn2*g)*1/vaer = H/v
-             taused(i,j)=(8.314*t(i)/28.e-3/1.35)/v1
+             g=g0*(rtit/(rtit+z(i)))**2
+             taused(i,j)=rgp*t(i)/(mn2*g)/v1
            enddo
          enddo
@@ -620,9 +624,14 @@
 
          zbx=z(h)+dz(h)/2.
+
+c ATTENTION !! 
+c toutes ces definitions sont contradictoires, 
+c pour mettre 0 au bout du compte...
+c A NETTOYER !!
+
          if(zbx.le.42000.) then
            kd=1.64e+12*(pb(h)/(kbz*tb(h)))**(-1./2.)
            kd=4.
          else
-           kd=0.0*kd
            kd=1.64e+12*(pb(h)/(kbz*tb(h)))**(-1./2.)
          endif
@@ -758,5 +767,6 @@
 *   rap= aar/an2  cst sur l'altitude
 
-         rap=0.191
+         rap=0.02
+c         rap=0.191
          do 23 i=1,nz
            an2(i)=(1.-ach4(i))/(1.+rap)
@@ -769,9 +779,9 @@
 24       continue
 
-         do 34 i=1,nz
+         do i=1,nz
            m=ach4(i)*mch4+an2(i)*mn2+aar(i)*mar
            rhob(i)=pb(i)*m/(rgp*tb(i))
 c          print*,pb(i),m,rgp,tb(i),rhob(i),rho(i)
-34       continue
+         enddo
 
 *  fin d'interpolation des taux de melange
Index: trunk/LMDZ.TITAN/libf/phytitan/calchim.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/calchim.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/calchim.F	(revision 1056)
@@ -1,3 +1,3 @@
-      SUBROUTINE calchim(ny,qy_c,nomqy_c,declin_rad,ls_rad,dtchim,
+      SUBROUTINE calchim(nlon,ny,qy_c,nomqy_c,declin_rad,ls_rad,dtchim,
      .                   ctemp,cplay,cplev,
      .                   dqyc)
@@ -9,8 +9,13 @@
 c     Auteur: S. Lebonnois,  01/2000 | 09/2003 
 c            adaptation pour Titan 3D: 02/2009
+c            adaptation pour // : 04/2013
 c
 c-------------------------------------------------
 c
       use dimphy
+      use common_mod, only:utilaer,maer,prodaer,csn,csh,psurfhaze,
+     .                     NLEV,NC,ND,NR
+      USE comgeomphy,  only: rlatd
+      use moyzon_mod,  only: klat
       implicit none
 #include "dimensions.h"
@@ -19,27 +24,26 @@
 #include "YOMCST.h"
 
-#include "titan_for.h"  
-!!!  doit etre en accord avec titan.h
-#include "aerprod.h"
-
 c    Arguments
 c    ---------
 
+      INTEGER      nlon                   ! nb of horiz points
       INTEGER      ny                     ! nb de composes (nqmax-nmicro) 
-      REAL         qy_c(jjm+1,klev,NC)    ! Especes chimiques apres adv.+diss.
+      REAL         qy_c(nlon,klev,NC)     ! Especes chimiques apres adv.+diss.
       character*10 nomqy_c(NC+1)          ! Noms des especes chimiques
       REAL         declin_rad,ls_rad      ! declinaison et long solaire en radians
       REAL         dtchim                 ! pas de temps chimie
-      REAL         ctemp(jjm+1,klev)      ! Temperature
-      REAL         cplay(jjm+1,klev)      ! pression (Pa)
-      REAL         cplev(jjm+1,klev)      ! pression intercouches (Pa)
-      
-      REAL         dqyc(jjm+1,klev,NC)    ! Tendances especes chimiques 
+      REAL         ctemp(nlon,klev)      ! Temperature
+      REAL         cplay(nlon,klev)      ! pression (Pa)
+      REAL         cplev(nlon,klev)      ! pression intercouches (Pa)
+      
+      REAL         dqyc(nlon,klev,NC)    ! Tendances especes chimiques 
       
 c    Local variables :
 c    -----------------
+
+      integer i,j,l,ic,jm1
+
 c variables envoyees dans la chimie: double precision
 
-      integer i,j,l,ic
       REAL  temp_c(klev),press_c(klev)     ! T,p(mbar) a 1 lat donnee
       REAL  declin_c                       ! declinaison en degres
@@ -64,5 +68,5 @@
       
       REAL  mass(NC),duree
-      REAL  tablefluxtop(NC,jjm+1,5)
+      REAL  tablefluxtop(NC,jjp1,5)
       REAL  botCH4
       DATA  botCH4/0.05/
@@ -90,5 +94,5 @@
 c ************************************
 
-        allocate(krpd(15,ND+1,klev,jjm+1),krate(klev,NR))
+        allocate(krpd(15,ND+1,klev,jjp1),krate(klev,NR))
 
 c Verification dimension verticale: coherence titan_for.h et klev
@@ -110,14 +114,14 @@
 	endif
 
-c calcul de temp_c, densites et press_c a l'equateur:
-c --------------------------------------------------
-
-        print*,'pression, densites et temp a l equateur (chimie):'
+c calcul de temp_c, densites et press_c au milieu de l'ensemble des points:
+c ----------------------------------------------------------------------
+
+        print*,'pression, densites et temp (chimie):'
         print*,'level, press_c, nb, temp_c'
         DO l=1,klev
 c     temp_c (K):
-         temp_c(l)  = ctemp(jjm/2+1,l)
+         temp_c(l)  = ctemp(nlon/2+1,l)
 c     press_c (mbar):
-         press_c(l) = cplay(jjm/2+1,l)/100.
+         press_c(l) = cplay(nlon/2+1,l)/100.
 c     nb (cm-3):
          nb(l) = 1.e-4*press_c(l) / (RKBOL*temp_c(l))
@@ -393,6 +397,14 @@
 c                BOUCLE SUR LES LATITUDES
 c
-      DO j=1,jjp1 
-      
+      DO j=1,nlon 
+      
+      if (j.eq.1) then 
+         jm1=1
+      else
+         jm1=j-1
+      endif
+
+      if((j.eq.1).or.(klat(j).ne.klat(jm1))) then
+
 c***********************************************************************
 c***********************************************************************
@@ -459,22 +471,4 @@
 c!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-       if (firstcal.and.(j.eq.1)) then
-         print*,'Alt, densites et temp au pole (chimie):'
-         print*,'level, z_bas, nb, temp_c'
-         do l=1,klev
-          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
-         enddo
-       endif
-
-       if (firstcal.and.(j.eq.jjm/2)) then
-c         print*,'g,mugaz'
-c         print*,g,mugaz
-         print*,'Alt, densites et temp a l equateur (chimie):'
-         print*,'level, z_bas, nb, temp_c'
-         do l=1,klev
-          print*,l,rinter(l)-RA/1000.,nb(l),temp_c(l)
-         enddo
-       endif
-       
 c-----------------------------------------------------------------------
 c
@@ -507,7 +501,7 @@
 c   --------------------
        
-       call gptitan(jjp1,rinter,temp_c,nb,
+       call gptitan(rinter,temp_c,nb,
      $              nomqy_c,cqy,fluxtop,
-     $              declin_c,duree,(j-1),mass,
+     $              declin_c,duree,(klat(j)-1),mass,
      $              botCH4,krpd,krate,reactif,
      $              nom_prod,nom_perte,prod,perte,
@@ -515,11 +509,4 @@
      $              htoh2,surfhaze)
        
-c       if ( j.eq.jjm/2 ) 
-c    $        print*,cqy(1,1),cqy(klev,1),cqy(1,2),cqy(klev,2)
-c       if ( j.eq.jjm/2 ) 
-c    $  print*,qy_c(j,1,1),qy_c(j,klev,1),qy_c(j,1,2),qy_c(j,klev,2)
-
-c       stop
-
 c   Tendances composition 
 c   ---------------------
@@ -551,7 +538,17 @@
 c***********************************************************************
 c***********************************************************************
-c
+
 c              FIN: BOUCLE SUR LES LATITUDES 
-c
+
+      else      ! same latitude, we don't do calculations again
+        dqyc(j,:,:) = dqyc(jm1,:,:)
+        if (aerprod.eq.1) then
+          prodaer(j,:,:) = prodaer(jm1,:,:) 
+          maer(j,:,:)    = maer(jm1,:,:)
+          csn(j,:,:)     = csn(jm1,:,:)
+          csh(j,:,:)     = csh(jm1,:,:)
+        endif
+      endif
+
       ENDDO
      
Index: trunk/LMDZ.TITAN/libf/phytitan/clesphys.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/clesphys.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/clesphys.h	(revision 1056)
@@ -30,4 +30,5 @@
        real    tx,tcorrect,p_prodaer
        real    xnuf 
+       REAL    xvis,xir
 
 
@@ -39,5 +40,5 @@
        COMMON/clesphys_r/                                               &
      &     ecritphy, solaire, z0, lmixmin, ksta, inertie, emis,         &
-     &     tx,tcorrect,p_prodaer,xnuf
+     &     tx,tcorrect,p_prodaer,xnuf,xvis,xir
 
        COMMON/clesphys_l/cycle_diurne, soil_model,                      &
Index: trunk/LMDZ.TITAN/libf/phytitan/coefkzmin.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/coefkzmin.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/coefkzmin.F	(revision 1056)
@@ -0,0 +1,136 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/phylmd/coefkzmin.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
+!
+       SUBROUTINE coefkzmin(ngrid,ypaprs,ypplay,yu,yv,yt,ycoefm
+     .   ,km,kn)
+c      SUBROUTINE coefkzmin(ngrid,zlev,teta,ustar,km,kn)
+
+      use dimphy
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "YOMCST.h"
+
+c.......................................................................
+c  Entrees modifies en attendant une version ou les zlev, et zlay soient
+c  disponibles.
+
+      REAL  ycoefm(klon,klev)
+
+      REAL yu(klon,klev), yv(klon,klev)
+      REAL yt(klon,klev)
+      REAL ypaprs(klon,klev+1), ypplay(klon,klev)
+      REAL yustar(klon)
+      real yzlay(klon,klev),yzlev(klon,klev+1),yteta(klon,klev)
+
+      integer i
+
+c.......................................................................
+c
+c  En entree :
+c  -----------
+c
+c zlev : altitude a chaque niveau (interface inferieure de la couche
+c        de meme indice)
+c ustar : u*
+c
+c teta : temperature potentielle au centre de chaque couche
+c        (en entree : la valeur au debut du pas de temps)
+c
+c  en sortier :
+c  ------------
+c
+c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
+c      couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
+c      (en sortie : la valeur a la fin du pas de temps)
+c
+c.......................................................................
+
+      real ustar(klon)
+      real kmin,qmin,pblhmin(klon),coriol(klon)
+      REAL zlev(klon,klev+1)
+      REAL teta(klon,klev)
+
+      REAL km(klon,klev+1)
+      REAL kn(klon,klev+1)
+      integer l_mix,ngrid
+
+
+      integer ig,k
+
+      real kap
+      save kap
+      data kap/0.4/
+
+c.......................................................................
+c  en attendant une version ou les zlev, et zlay soient
+c  disponibles.
+c  Debut de la partie qui doit etre unclue a terme dans clmain.
+c
+         do i=1,ngrid
+            yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1)))
+     .                *(ypaprs(i,1)-ypplay(i,1))/RG
+         enddo
+         do k=2,klev
+            do i=1,ngrid
+               yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k))
+     s                /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG
+            enddo
+         enddo
+         do k=1,klev
+            do i=1,ngrid
+cATTENTION:on passe la temperature potentielle virt. pour le calcul de K
+             yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa
+            enddo
+         enddo
+         do i=1,ngrid
+            yzlev(i,1)=0.
+            yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1)
+         enddo
+         do k=2,klev
+            do i=1,ngrid
+               yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1))
+            enddo
+         enddo
+
+
+cIM cf FH   yustar(:) =SQRT(ycoefm(:,1)*(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1)))
+      yustar(1:ngrid) =SQRT(ycoefm(1:ngrid,1)*
+     $       (yu(1:ngrid,1)*yu(1:ngrid,1)+yv(1:ngrid,1)*yv(1:ngrid,1)))
+
+c  Fin de la partie qui doit etre unclue a terme dans clmain.
+
+Cette routine est ecrite pour avoir en entree ustar, teta et zlev
+c  Ici, on a inclut le calcul de ces trois variables dans la routine
+c  coefkzmin en attendant une nouvelle version de la couche limite
+c  ou ces variables seront disponibles.
+
+c Debut de la routine coefkzmin proprement dite.
+
+      ustar=yustar
+      teta=yteta
+      zlev=yzlev
+
+      do ig=1,ngrid
+      coriol(ig)=1.e-4
+      pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
+      enddo
+      
+      do k=2,klev
+         do ig=1,ngrid
+            if (teta(ig,2).gt.teta(ig,1)) then
+               qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
+               kmin=kap*zlev(ig,k)*qmin
+            else
+               kmin=0. ! kmin n'est utilise que pour les SL stables.
+            endif 
+            kn(ig,k)=kmin
+            km(ig,k)=kmin
+         enddo
+      enddo
+
+
+      return
+      end
Index: trunk/LMDZ.TITAN/libf/phytitan/comg1d.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/comg1d.h	(revision 1055)
+++ 	(revision )
@@ -1,63 +1,0 @@
-c.......................................................................
-c  le COMMON pour GRADS-1D
-c  (Utilise pour les sorties format Grads dans la version 1D du modele)
-c
-c  on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?"
-c
-      INTEGER g1d_nvarmx
-      PARAMETER(g1d_nvarmx=1000)
-c
-c         * g1d_nlayer     ---> nombre de couches verticales
-c         * g1d_nomfich    ---> nom du fichier grads
-c         * g1d_unitfich   ---> code du fichier grads
-c         * g1d_nomctl     ---> nom du fichier ctl
-c         * g1d_unitctl    ---> code du fichier ctl
-c         * g1d_premier    ---> variable logique pour dire si le fichier
-c                               est deja ouvert
-c         * g1d_irec       ---> indice de derniere ecriture
-c         * g1d_nvar       ---> nombre de variables deja definies a la
-c                               derniere ecriture
-c         * g1d_nomvar     ---> noms des vecteurs existants
-c         * g1d_dimvar     ---> taille des vecteurs
-c         * g1d_titrevar   ---> titres des vecteurs
-c         * g1d_tmp1       ---> caractere 
-c         * g1d_tmp2       ---> caractere 
-c
-      INTEGER g1d_nlayer
-      CHARACTER*100 g1d_nomfich
-      INTEGER g1d_unitfich
-      CHARACTER*100 g1d_nomctl
-      INTEGER g1d_unitctl
-      LOGICAL g1d_premier
-      LOGICAL g2d_premier
-      INTEGER g1d_irec
-      INTEGER g2d_irec
-      INTEGER g2d_appel
-      INTEGER g1d_nvar
-      CHARACTER*100 g1d_nomvar
-      INTEGER g1d_dimvar
-      CHARACTER*100 g1d_titrevar
-      CHARACTER*100 g1d_tmp1,g1d_tmp2
-c
-      COMMON/COMG1DI/g1d_nlayer
-     &             ,g1d_unitfich
-     &             ,g1d_unitctl
-     &             ,g1d_irec
-     &             ,g2d_irec
-     &             ,g2d_appel
-     &             ,g1d_nvar
-      COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx)
-     &             ,g1d_nomfich
-     &             ,g1d_nomctl
-     &             ,g1d_nomvar(0:g1d_nvarmx)
-     &             ,g1d_titrevar(0:g1d_nvarmx)
-     &             ,g1d_tmp1
-     &             ,g1d_tmp2
-      COMMON/COMG1DL/g1d_premier
-     &             ,g2d_premier
-c
-
-      integer nbphypers
-      common/rythme/nbphypers
-c.......................................................................
-
Index: trunk/LMDZ.TITAN/libf/phytitan/comgeomphy.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/comgeomphy.F90	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/comgeomphy.F90	(revision 1056)
@@ -9,13 +9,13 @@
   
   subroutine initcomgeomphy
-  use dimphy
+  USE mod_phys_lmdz_para
   implicit none
     
  
-    allocate(airephy(klon))
-    allocate(cuphy(klon))
-    allocate(cvphy(klon))
-    allocate(rlatd(klon))
-    allocate(rlond(klon))
+    allocate(airephy(klon_omp))
+    allocate(cuphy(klon_omp))
+    allocate(cvphy(klon_omp))
+    allocate(rlatd(klon_omp))
+    allocate(rlond(klon_omp))
 
   end subroutine initcomgeomphy
Index: trunk/LMDZ.TITAN/libf/phytitan/common_mod.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/common_mod.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/common_mod.F90	(revision 1056)
@@ -0,0 +1,118 @@
+      MODULE common_mod
+! Variables sauvegardees - anciens common
+!======================================================================
+!
+!
+!======================================================================
+! Declaration des variables
+      USE dimphy
+      implicit none
+#include "dimensions.h"
+
+! ancien rnuabar
+      REAL,    ALLOCATABLE, SAVE :: rmcbar(:,:),xfbar(:,:,:)
+      INTEGER, ALLOCATABLE, SAVE :: ncount(:,:)
+!$OMP THREADPRIVATE(rmcbar,xfbar)
+!$OMP THREADPRIVATE(ncount)
+
+! Common de aerprod.h... aerprod et htoh2
+! Etaient utilises par calchim et la microphysique pour echanger 
+! des variables pour la production des aerosols par la chimie
+! et la chimie heterogene de H a la surface des aerosols
+! Ca a disparu de la microphysique... 
+! A remettre si on veut reutiliser cette fonctionnalite
+
+! ancien aerprod
+      INTEGER, SAVE :: utilaer(16)
+      REAL,    ALLOCATABLE, SAVE :: maer(:,:,:),prodaer(:,:,:)
+      REAL,    ALLOCATABLE, SAVE :: csn(:,:,:),csh(:,:,:)
+!$OMP THREADPRIVATE(utilaer)
+!$OMP THREADPRIVATE(maer,prodaer,csn,csh)
+! ancien htoh2
+      REAL,    ALLOCATABLE, SAVE :: psurfhaze(:,:)
+!$OMP THREADPRIVATE(psurfhaze)
+
+! ancien titan_for.h
+      INTEGER, PARAMETER :: NLEV=llm,NC=44,ND=54,NR=377
+!$OMP THREADPRIVATE(NLEV,NC,ND,NR)
+!!!  doivent etre en accord avec titan.h
+
+! ancien diagmuphy.h
+!     toutes les variables
+!     diagnostiques sorties de la microphysique.
+
+! ---- flux de glace (1:CH4 / 2:C2H6 / 3:C2H2)
+      REAL, ALLOCATABLE, SAVE :: flxesp_i(:,:,:)
+!$OMP THREADPRIVATE(flxesp_i)
+! ---- taux sedimentation gouttes, aerosols sec
+      REAL, ALLOCATABLE, SAVE :: tau_drop(:,:),tau_aer(:,:,:)
+!$OMP THREADPRIVATE(tau_drop,tau_aer)
+! ---- Production de glace (negatif si disparition)
+      REAL, ALLOCATABLE, SAVE :: solesp(:,:,:)
+!$OMP THREADPRIVATE(solesp)
+! ---- Evaporation CH4
+      REAL, ALLOCATABLE, SAVE :: evapch4(:)
+!$OMP THREADPRIVATE(evapch4)
+! ---- occurences des nuages
+      REAL, ALLOCATABLE, SAVE :: occcld_m(:,:,:)
+!$OMP THREADPRIVATE(occcld_m)
+! ---- occcld sert a obtenir les opacités/extinction des nuages (proxy)
+      REAL, ALLOCATABLE, SAVE :: occcld(:,:)
+!$OMP THREADPRIVATE(occcld)
+! ---- saturation CH4,C2H6,C2H2
+      REAL, ALLOCATABLE, SAVE :: satch4(:,:),satc2h6(:,:),satc2h2(:,:)
+!$OMP THREADPRIVATE(satch4,satc2h6,satc2h2)
+! ---- precipitations (CH4, C2H6, C2H2, noyaux, aerosols)
+      REAL, ALLOCATABLE, SAVE :: precip(:,:)
+!$OMP THREADPRIVATE(precip)
+! ---- rayon moyen des gouttes
+      REAL, ALLOCATABLE, SAVE :: rmcloud(:,:)
+!$OMP THREADPRIVATE(rmcloud)
+
+! Anciently /TAUD/
+      REAL, ALLOCATABLE, SAVE :: TauHID(:,:,:) ! cumulative Haze   IR  opacity
+      REAL, ALLOCATABLE, SAVE :: TauCID(:,:,:) ! cumulative Clouds IR  opacity
+      REAL, ALLOCATABLE, SAVE :: TauGID(:,:,:) ! cumulative Gas    IR  opacity
+      REAL, ALLOCATABLE, SAVE :: TauHVD(:,:,:) ! cumulative Haze   Vis opacity
+      REAL, ALLOCATABLE, SAVE :: TauCVD(:,:,:) ! cumulative Clouds Vis opacity
+      REAL, ALLOCATABLE, SAVE :: TauGVD(:,:,:) ! cumulative Gas    Vis opacity
+!$OMP THREADPRIVATE(TauHID,TauCID,TauGID)
+!$OMP THREADPRIVATE(TauHVD,TauCVD,TauGVD)
+! besoin en plus en l'absence de racommon_h
+      INTEGER,PARAMETER :: NSPECI=46,NSPECV=24
+
+CONTAINS
+
+!======================================================================
+SUBROUTINE common_init
+use dimphy
+USE control_mod
+IMPLICIT NONE
+#include "dimensions.h"
+#include "microtab.h"
+
+      ALLOCATE(rmcbar(klon,klev),xfbar(klon,klev,4))
+      ALLOCATE(ncount(klon,klev))
+
+      ALLOCATE(maer(klon,klev,4),prodaer(klon,klev,4))
+      ALLOCATE(csn(klon,klev,4),csh(klon,klev,4))
+      ALLOCATE(psurfhaze(klon,klev))
+
+      ALLOCATE(flxesp_i(klon,klev,3),tau_drop(klon,klev))
+      ALLOCATE(tau_aer(klon,klev,nrad),solesp(klon,klev,3))
+      ALLOCATE(evapch4(klon),occcld_m(klon,klev,12))
+      ALLOCATE(occcld(klon,klev),satch4(klon,klev))
+      ALLOCATE(satc2h6(klon,klev),satc2h2(klon,klev))
+      ALLOCATE(precip(klon,5),rmcloud(klon,klev))
+
+      ALLOCATE(TauHID(klon,klev,NSPECI))
+      ALLOCATE(TauCID(klon,klev,NSPECI))
+      ALLOCATE(TauGID(klon,klev,NSPECI))
+      ALLOCATE(TauHVD(klon,klev,NSPECV))
+      ALLOCATE(TauCVD(klon,klev,NSPECV))
+      ALLOCATE(TauGVD(klon,klev,NSPECV))
+
+END SUBROUTINE common_init
+
+!======================================================================
+      END MODULE common_mod
Index: trunk/LMDZ.TITAN/libf/phytitan/conf_phys.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/conf_phys.F90	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/conf_phys.F90	(revision 1056)
@@ -374,4 +374,20 @@
   call getin('tcorrect',tcorrect)
 
+!
+!Config Key  = xvis
+!Config Desc = Facteur d ajustement des proprietes vis des aerosols
+!Config Def  = 1.5
+!Config Help =
+!
+  xvis = 1.0
+  call getin('xvis',xvis)
+!
+!Config Key  = xir
+!Config Desc = Facteur d ajustement des proprietes IR des aerosols
+!Config Def  = 0.5
+!Config Help =
+!
+  xir = 1.0
+  call getin('xir',xir)
 !
 !Config Key  = p_prodaer
@@ -487,4 +503,6 @@
   write(numout,*)' tx = ', tx
   write(numout,*)' tcorrect = ', tcorrect
+  write(numout,*)' xvis = ', xvis
+  write(numout,*)' xir = ', xir
   write(numout,*)' p_prodaer = ', p_prodaer
   write(numout,*)' cutoff = ', cutoff
Index: trunk/LMDZ.TITAN/libf/phytitan/diagmuphy.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/diagmuphy.h	(revision 1055)
+++ 	(revision )
@@ -1,37 +1,0 @@
-!     Ce header contient toutes les variables
-!     diagnostiques sorties de la microphysique.
-!
-!  ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX
-      INTEGER   ngd
-      PARAMETER (ngd=(jjm-1)*iim+2)  ! = klon
-!
-! ---- flux de glace (1:CH4 / 2:C2H6 / 3:C2H2)
-       REAL flxesp_i(ngd,llm,3)
-! ---- taux sedimentation gouttes
-       REAL tau_drop(ngd,llm)
-! ---- taux sedimentation aerosols sec
-       REAL tau_aer(ngd,llm,nrad)
-! ---- Production de glace (negatif si disparition)
-       REAL solesp(ngd,llm,3)
-! ---- Evaporation CH4
-       REAL evapch4(ngd)
-! ---- occurences des nuages
-       REAL occcld_m(ngd,llm,12) 
-! ---- occcld sert a obtenir les opacités/extinction des nuages (proxy)
-       REAL occcld(ngd,llm)
-! ---- saturation CH4 
-       REAL satch4(ngd,llm)
-! ---- saturation C2H6
-       REAL satc2h6(ngd,llm)
-! ---- saturation C2H2 
-       REAL satc2h2(ngd,llm)
-! ---- precipitations (CH4, C2H6, C2H2, noyaux, aerosols)
-       REAL precip(ngd,5)
-! ---- rayon moyen des gouttes
-       REAL rmcloud(ngd,llm)
-    
-       common/diagmuphy/flxesp_i,tau_drop,tau_aer,                      &
-     &                  solesp,evapch4,occcld_m,occcld,                 &
-     &                  satch4,satc2h6,satc2h2,                         &
-     &                  precip,rmcloud
-
Index: trunk/LMDZ.TITAN/libf/phytitan/dimphy.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/dimphy.F90	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/dimphy.F90	(revision 1056)
@@ -8,9 +8,6 @@
   INTEGER,SAVE :: klevp1
   INTEGER,SAVE :: klevm1
-  INTEGER,SAVE :: kflev
 
 !$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon)
-  REAL,save,allocatable,dimension(:) :: zmasq
-!$OMP THREADPRIVATE(zmasq)   
 
 CONTAINS
@@ -31,7 +28,5 @@
     klevp1=klev+1
     klevm1=klev-1
-    kflev=klev
 !$OMP END MASTER    
-    ALLOCATE(zmasq(klon))    
     
   END SUBROUTINE init_dimphy
Index: trunk/LMDZ.TITAN/libf/phytitan/drag_noro.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/drag_noro.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/drag_noro.F	(revision 1056)
@@ -0,0 +1,170 @@
+
+C  SUBROUTINE DE PARAMETRISATION DES MONTAGNES D ECHELLE SOUS MAILLE
+
+      SUBROUTINE drag_noro (nlon,nlev,dtime,paprs,pplay,pgeop,pn2,
+     e                   pmea,pstd, psig, pgam, pthe,ppic,pval,
+     e                   kgwd,kdx,ktest,
+     e                   t, u, v,
+     s                   pulow, pvlow, pustr, pvstr,
+     s                   d_t, d_u, d_v)
+c
+      use dimphy
+      IMPLICIT none
+
+#include "dimensions.h"
+#include "paramet.h"
+
+c======================================================================
+c Auteur(s): F.Lott (LMD/CNRS) date: 19950201
+c Object: Mountain drag interface. Made necessary because:
+C 1. in the LMD-GCM Layers are from bottom to top,
+C    contrary to most European GCM.
+c 2. the altitude above ground of each model layers
+c    needs to be known (variable zgeom)
+c======================================================================
+c Explicit Arguments:
+c ==================
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c dtime---input-R-Time-step (s)
+c paprs---input-R-Pressure in semi layers    (Pa)
+c pplay---input-R-Pressure model-layers      (Pa)
+c pgeop---input-R-Geopotential model layers      (m)
+c pn2-----input-R-Brunt-Vaisala freq.^2 at 1/2 layers
+c t-------input-R-temperature (K)
+c u-------input-R-Horizontal wind (m/s)
+c v-------input-R-Meridional wind (m/s)
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+
+c pulow, pvlow -output-R: Low-level wind
+c pustr, pvstr -output-R: Surface stress due to SSO drag      (Pa)
+c
+c d_t-----output-R: T increment            
+c d_u-----output-R: U increment              
+c d_v-----output-R: V increment              
+c
+c Implicit Arguments:
+c ===================
+c
+c iim--common-I: Number of longitude intervals
+c jjm--common-I: Number of latitude intervals
+c klon-common-I: Number of points seen by the physics
+c                (iim+1)*(jjm+1) for instance
+c klev-common-I: Number of vertical layers
+c======================================================================
+c Local Variables:
+c ================
+c
+c zgeom-----R: Altitude of layer above ground
+c pt, pu, pv --R: t u v from top to bottom
+c pdtdt, pdudt, pdvdt --R: t u v tendencies (from top to bottom) 
+c papmf: pressure at model layer (from top to bottom)
+c papmh: pressure at model 1/2 layer (from top to bottom)
+c 
+c======================================================================
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c  ARGUMENTS
+c
+      INTEGER nlon,nlev
+      REAL dtime
+      REAL paprs(nlon,nlev+1)
+      REAL pplay(nlon,nlev)
+      REAL pgeop(nlon,nlev),pn2(nlon,nlev)
+      REAL pmea(nlon),pstd(nlon),psig(nlon),pgam(nlon),pthe(nlon)
+      REAL ppic(nlon),pval(nlon)
+      REAL pulow(nlon),pvlow(nlon),pustr(nlon),pvstr(nlon)
+      REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)
+      REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)
+c
+      INTEGER i, k, kgwd,  kdx(nlon), ktest(nlon)
+c
+c LOCAL VARIABLES:
+c
+      REAL zgeom(klon,klev),zn2(klon,klev)
+      REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)
+      REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)
+      REAL papmf(klon,klev),papmh(klon,klev+1)
+c
+c INITIALIZE OUTPUT VARIABLES 
+c
+      DO i = 1,klon
+         pulow(i) = 0.0
+         pvlow(i) = 0.0
+         pustr(i) = 0.0
+         pvstr(i) = 0.0
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+         d_t(i,k) = 0.0
+         d_u(i,k) = 0.0
+         d_v(i,k) = 0.0
+         pdudt(i,k)=0.0
+         pdvdt(i,k)=0.0
+         pdtdt(i,k)=0.0
+      ENDDO
+      ENDDO
+c
+c PREPARE INPUT VARIABLES FOR ORODRAG (i.e., ORDERED FROM TOP TO BOTTOM)
+C CALCULATE LAYERS HEIGHT ABOVE GROUND)
+c
+      DO k = 1, klev
+      DO i = 1, klon
+         pt(i,k) = t(i,klev-k+1) 
+         pu(i,k) = u(i,klev-k+1)
+         pv(i,k) = v(i,klev-k+1)
+         papmf(i,k) = pplay(i,klev-k+1)
+      ENDDO
+      ENDDO
+      DO k = 1, klev+1
+      DO i = 1, klon
+         papmh(i,k) = paprs(i,klev-k+2)
+      ENDDO
+      ENDDO
+
+      DO k = klev, 1, -1
+      DO i = 1, klon
+         zgeom(i,k) = pgeop(i,klev-k+1)
+	 zn2(i,k)   = pn2(i,klev-k+1)
+      ENDDO
+      ENDDO
+
+c CALL SSO DRAG ROUTINES        
+c
+      CALL orodrag(klon,klev,kgwd,kdx,ktest,
+     .            dtime,
+     .            papmh, papmf, zgeom, zn2,
+     .            pt, pu, pv,
+     .            pmea, pstd, psig, pgam, pthe, ppic,pval,
+     .            pulow,pvlow,
+     .            pdudt,pdvdt,pdtdt)
+C
+C COMPUTE INCREMENTS AND STRESS FROM TENDENCIES
+
+      DO k = 1, klev
+      DO i = 1, klon
+         d_u(i,klev+1-k) = dtime*pdudt(i,k)
+         d_v(i,klev+1-k) = dtime*pdvdt(i,k)
+         d_t(i,klev+1-k) = dtime*pdtdt(i,k)
+         pustr(i)        = pustr(i)
+     .                    +pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+         pvstr(i)        = pvstr(i)
+     .                    +pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg
+      ENDDO
+      ENDDO
+c
+      RETURN
+      END
+
Index: trunk/LMDZ.TITAN/libf/phytitan/grid_noro.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/grid_noro.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/grid_noro.F	(revision 1056)
@@ -0,0 +1,483 @@
+!
+! $Id: grid_noro.F 1442 2010-10-18 08:31:31Z jghattas $
+!
+c
+c
+      SUBROUTINE grid_noro(imdep, jmdep, xdata, ydata, zdata,
+     .             imar, jmar, x, y,
+     .             zphi,zmea,zstd,zsig,zgam,zthe,
+     .             zpic,zval)
+c=======================================================================
+c (F. Lott) (voir aussi z.x. Li, A. Harzallah et L. Fairhead)
+c
+c      Compute the Parameters of the SSO scheme as described in
+c      LOTT & MILLER (1997) and LOTT(1999).
+c      Target points are on a rectangular grid:
+c      iim+1 latitudes including North and South Poles;
+c      jjm+1 longitudes, with periodicity jjm+1=1.
+c      aux poles.  At the poles the fields value is repeated
+c      jjm+1 time.
+c      The parameters a,b,c,d represent the limite of the target
+c      gridpoint region. The means over this region are calculated
+c      from USN data, ponderated by a weight proportional to the 
+c      surface occupated by the data inside the model gridpoint area.
+c      In most circumstances, this weight is the ratio between the
+c      surface of the USN gridpoint area and the surface of the
+c      model gridpoint area. 
+c
+c           (c)
+c        ----d-----
+c        | . . . .|
+c        |        |
+c     (b)a . * . .b(a)
+c        |        |
+c        | . . . .|
+c        ----c-----
+c           (d)
+C=======================================================================
+c INPUT:
+c        imdep, jmdep: dimensions X and Y input field
+c        xdata, ydata: coordinates X and Y input field
+c        zdata: Input field
+c OUTPUT:
+c        imar, jmar: dimensions X and Y Output field
+c        x, y: ccordinates  X and Y Output field.
+c             zmea:  Mean orographie   
+c             zstd:  Standard deviation
+c             zsig:  Slope
+c             zgam:  Anisotropy
+c             zthe:  Orientation of the small axis
+c             zpic:  Maximum altitude
+c             zval:  Minimum altitude
+C=======================================================================
+
+      IMPLICIT none 
+      
+#include "dimensions.h"
+#include "YOMCST.h"
+
+      INTEGER imdep, jmdep
+      REAL xdata(imdep),ydata(jmdep) 
+      REAL zdata(imdep,jmdep)
+c
+      INTEGER imar, jmar
+c parametres lies au fichier d entree... A documenter...
+      integer iext
+      parameter(iext=216)
+      REAL xusn(imdep+2*iext),yusn(jmdep+2)
+      REAL zusn(imdep+2*iext,jmdep+2)
+  
+c local var
+      real zdeltax,zdeltay,zlenx,zleny,xincr
+      real zbordnor,zbordsud,zbordest,zbordoue,weighx,weighy
+      real zllmmea,zllmstd,zllmsig,zllmgam,zllmpic,zllmval,zllmthe
+      real zminthe,xk,xl,xm,xp,xq,xw
+      real zmeanor,zmeasud,zstdnor,zstdsud,zsignor,zsigsud
+      real zweinor,zweisud,zpicnor,zpicsud,zvalnor,zvalsud
+      integer i,j,ii,jj
+
+C INTERMEDIATE FIELDS  (CORRELATIONS OF OROGRAPHY GRADIENT)
+
+      REAL ztz(iim+1,jjm+1),zxtzx(iim+1,jjm+1)
+      REAL zytzy(iim+1,jjm+1),zxtzy(iim+1,jjm+1)
+      REAL weight(iim+1,jjm+1)
+
+C CORRELATIONS OF USN OROGRAPHY GRADIENTS
+
+      REAL zxtzxusn(imdep+2*iext,jmdep+2)
+      REAL zytzyusn(imdep+2*iext,jmdep+2)
+      REAL zxtzyusn(imdep+2*iext,jmdep+2)
+      REAL x(imar+1),y(jmar),zphi(imar+1,jmar)
+      REAL zmea(imar+1,jmar),zstd(imar+1,jmar)
+      REAL zsig(imar+1,jmar),zgam(imar+1,jmar),zthe(imar+1,jmar)
+      REAL zpic(imar+1,jmar),zval(imar+1,jmar)
+      real num_tot(2200,1100),num_lan(2200,1100)
+c
+      REAL a(2200),b(2200),c(1100),d(1100)
+c
+      print *,' parametres de l orographie a l echelle sous maille' 
+
+      zdeltay=2.*RPI/REAL(jmdep)*RA
+c
+c  quelques tests de dimensions:
+c    
+c
+      if(iim.ne.imar) STOP 'Problem dim. x'
+      if(jjm.ne.jmar-1) STOP 'Problem dim. y'
+      IF (imar.GT.2200 .OR. jmar.GT.1100) THEN
+         PRINT*, 'imar or jmar too big', imar, jmar
+         CALL ABORT
+      ENDIF
+
+      IF(imar+1.ne.iim+1.or.jmar.ne.jjm+1)THEN
+        print *,' imar or jmar bad dimensions:',imar,jmar
+        call abort
+      ENDIF
+
+
+c      print *,'xdata:',xdata
+c      print *,'ydata:',ydata
+c      print *,'x:',x
+c      print *,'y:',y
+c
+C  EXTENSION OF THE USN DATABASE TO POCEED COMPUTATIONS AT
+C  BOUNDARIES:
+c
+      DO j=1,jmdep
+        yusn(j+1)=ydata(j)
+      DO i=1,imdep
+        zusn(i+iext,j+1)=zdata(i,j)
+        xusn(i+iext)=xdata(i)
+      ENDDO
+      DO i=1,iext
+        zusn(i,j+1)=zdata(imdep-iext+i,j)
+        xusn(i)=xdata(imdep-iext+i)-2.*RPI
+        zusn(imdep+iext+i,j+1)=zdata(i,j)
+        xusn(imdep+iext+i)=xdata(i)+2.*RPI
+      ENDDO
+      ENDDO
+
+        yusn(1)=ydata(1)+(ydata(1)-ydata(2))
+        yusn(jmdep+2)=ydata(jmdep)+(ydata(jmdep)-ydata(jmdep-1))
+       DO i=1,imdep/2+iext
+        zusn(i,1)=zusn(i+imdep/2,2)
+        zusn(i+imdep/2+iext,1)=zusn(i,2)
+        zusn(i,jmdep+2)=zusn(i+imdep/2,jmdep+1)
+        zusn(i+imdep/2+iext,jmdep+2)=zusn(i,jmdep+1)
+       ENDDO
+c  
+c COMPUTE LIMITS OF MODEL GRIDPOINT AREA
+C     ( REGULAR GRID)
+c
+      a(1) = x(1) - (x(2)-x(1))/2.0
+      b(1) = (x(1)+x(2))/2.0
+      DO i = 2, imar
+         a(i) = b(i-1)
+         b(i) = (x(i)+x(i+1))/2.0
+      ENDDO
+      a(imar+1) = b(imar)
+      b(imar+1) = x(imar+1) + (x(imar+1)-x(imar))/2.0
+
+      c(1) = y(1) - (y(2)-y(1))/2.0
+      d(1) = (y(1)+y(2))/2.0
+      DO j = 2, jmar-1
+         c(j) = d(j-1)
+         d(j) = (y(j)+y(j+1))/2.0
+      ENDDO
+      c(jmar) = d(jmar-1)
+      d(jmar) = y(jmar) + (y(jmar)-y(jmar-1))/2.0
+c
+c  initialisations:
+c
+      DO i = 1, imar+1
+      DO j = 1, jmar
+         weight(i,j) = 0.0
+         zxtzx(i,j)  = 0.0
+         zytzy(i,j)  = 0.0
+         zxtzy(i,j)  = 0.0
+         ztz(i,j)    = 0.0
+         zmea(i,j)   = 0.0
+         zpic(i,j)  =-1.E+10
+         zval(i,j)  = 1.E+10
+      ENDDO
+      ENDDO
+c
+c  COMPUTE SLOPES CORRELATIONS ON USN GRID
+c
+         DO j = 1,jmdep+2 
+         DO i = 1, imdep+2*iext
+            zytzyusn(i,j)=0.0
+            zxtzxusn(i,j)=0.0
+            zxtzyusn(i,j)=0.0
+         ENDDO
+         ENDDO
+
+
+         DO j = 2,jmdep+1 
+            zdeltax=zdeltay*cos(yusn(j))
+         DO i = 2, imdep+2*iext-1
+            zytzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))**2/zdeltay**2
+            zxtzxusn(i,j)=(zusn(i+1,j)-zusn(i-1,j))**2/zdeltax**2
+            zxtzyusn(i,j)=(zusn(i,j+1)-zusn(i,j-1))/zdeltay
+     *                   *(zusn(i+1,j)-zusn(i-1,j))/zdeltax
+         ENDDO
+         ENDDO
+c
+c  SUMMATION OVER GRIDPOINT AREA
+c 
+      zleny=RPI/REAL(jmdep)*RA
+      xincr=RPI/2./REAL(jmdep)
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+       num_tot(ii,jj)=0.
+       num_lan(ii,jj)=0.
+c        PRINT *,' iteration ii jj:',ii,jj
+         DO j = 2,jmdep+1 
+c         DO j = 3,jmdep 
+            zlenx=zleny*cos(yusn(j))
+            zdeltax=zdeltay*cos(yusn(j))
+            zbordnor=(c(jj)-yusn(j)+xincr)*RA
+            zbordsud=(yusn(j)-d(jj)+xincr)*RA
+            weighy=AMAX1(0.,
+     *             amin1(zbordnor,zbordsud,zleny))
+         IF(weighy.ne.0)THEN
+         DO i = 2, imdep+2*iext-1
+            zbordest=(xusn(i)-a(ii)+xincr)*RA*cos(yusn(j))
+            zbordoue=(b(ii)+xincr-xusn(i))*RA*cos(yusn(j))
+            weighx=AMAX1(0.,
+     *             amin1(zbordest,zbordoue,zlenx))
+            IF(weighx.ne.0)THEN
+            num_tot(ii,jj)=num_tot(ii,jj)+1.0
+            if(zusn(i,j).ge.1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
+            weight(ii,jj)=weight(ii,jj)+weighx*weighy
+            zxtzx(ii,jj)=zxtzx(ii,jj)+zxtzxusn(i,j)*weighx*weighy
+            zytzy(ii,jj)=zytzy(ii,jj)+zytzyusn(i,j)*weighx*weighy
+            zxtzy(ii,jj)=zxtzy(ii,jj)+zxtzyusn(i,j)*weighx*weighy
+            ztz(ii,jj)  =ztz(ii,jj)  +zusn(i,j)*zusn(i,j)*weighx*weighy
+c mean
+            zmea(ii,jj) =zmea(ii,jj)+zusn(i,j)*weighx*weighy
+c peacks
+            zpic(ii,jj)=amax1(zpic(ii,jj),zusn(i,j))
+c valleys
+            zval(ii,jj)=amin1(zval(ii,jj),zusn(i,j))
+            ENDIF
+         ENDDO
+         ENDIF
+         ENDDO
+       ENDDO
+       ENDDO
+c
+c  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
+C  LOTT (1999) SSO SCHEME.
+c
+      zllmmea=0.
+      zllmstd=0.
+      zllmsig=0.
+      zllmgam=0.
+      zllmpic=0.
+      zllmval=0.
+      zllmthe=0.
+      zminthe=0.
+c     print 100,' '
+c100  format(1X,A1,'II JJ',4X,'H',8X,'SD',8X,'SI',3X,'GA',3X,'TH') 
+       DO ii = 1, imar+1
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Mean Orography:
+           zmea (ii,jj)=zmea (ii,jj)/weight(ii,jj)
+           zxtzx(ii,jj)=zxtzx(ii,jj)/weight(ii,jj)
+           zytzy(ii,jj)=zytzy(ii,jj)/weight(ii,jj)
+           zxtzy(ii,jj)=zxtzy(ii,jj)/weight(ii,jj)
+           ztz(ii,jj)  =ztz(ii,jj)/weight(ii,jj)
+c  Standard deviation:
+           zstd(ii,jj)=sqrt(AMAX1(0.,ztz(ii,jj)-zmea(ii,jj)**2))
+         ELSE
+            PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+       ENDDO
+       ENDDO
+
+C CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
+
+       DO ii = 1, imar+1
+         zxtzx(ii,1)=zxtzx(ii,2)
+         zxtzx(ii,jmar)=zxtzx(ii,jmar-1)
+         zxtzy(ii,1)=zxtzy(ii,2)
+         zxtzy(ii,jmar)=zxtzy(ii,jmar-1)
+         zytzy(ii,1)=zytzy(ii,2)
+         zytzy(ii,jmar)=zytzy(ii,jmar-1)
+       ENDDO
+
+C  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
+
+C  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
+
+       CALL MVA9(zmea,iim+1,jjm+1)
+       CALL MVA9(zstd,iim+1,jjm+1)
+       CALL MVA9(zpic,iim+1,jjm+1)
+       CALL MVA9(zval,iim+1,jjm+1)
+       CALL MVA9(zxtzx,iim+1,jjm+1)
+       CALL MVA9(zxtzy,iim+1,jjm+1) 
+       CALL MVA9(zytzy,iim+1,jjm+1)
+
+       DO ii = 1, imar
+       DO jj = 1, jmar
+         IF (weight(ii,jj) .NE. 0.0) THEN
+c  Coefficients K, L et M:
+           xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
+           xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
+           xm=zxtzy(ii,jj)
+           xp=xk-sqrt(xl**2+xm**2)
+           xq=xk+sqrt(xl**2+xm**2)
+           xw=1.e-8
+           if(xp.le.xw) xp=0.
+           if(xq.le.xw) xq=xw
+           if(abs(xm).le.xw) xm=xw*sign(1.,xm)
+c slope: 
+           zsig(ii,jj)=sqrt(xq)
+c isotropy:
+           zgam(ii,jj)=xp/xq
+c angle theta:
+           zthe(ii,jj)=57.29577951*atan2(xm,xl)/2.
+           zphi(ii,jj)=zmea(ii,jj)
+           !
+           zmea(ii,jj)=zmea(ii,jj)
+           zpic(ii,jj)=zpic(ii,jj)
+           zval(ii,jj)=zval(ii,jj)
+           zstd(ii,jj)=zstd(ii,jj)
+c          print 101,ii,jj,
+c    *           zmea(ii,jj),zstd(ii,jj),zsig(ii,jj),zgam(ii,jj),
+c    *           zthe(ii,jj)
+c101  format(1x,2(1x,i2),2(1x,f7.1),1x,f7.4,2x,f4.2,1x,f5.1)     
+         ELSE
+c           PRINT*, 'probleme,ii,jj=', ii,jj
+         ENDIF
+      zllmmea=AMAX1(zmea(ii,jj),zllmmea)
+      zllmstd=AMAX1(zstd(ii,jj),zllmstd)
+      zllmsig=AMAX1(zsig(ii,jj),zllmsig)
+      zllmgam=AMAX1(zgam(ii,jj),zllmgam)
+      zllmthe=AMAX1(zthe(ii,jj),zllmthe)
+      zminthe=amin1(zthe(ii,jj),zminthe)
+      zllmpic=AMAX1(zpic(ii,jj),zllmpic)
+      zllmval=AMAX1(zval(ii,jj),zllmval)
+       ENDDO
+       ENDDO
+      print *,'  MEAN ORO:',zllmmea
+      print *,'  ST. DEV.:',zllmstd
+      print *,'  PENTE:',zllmsig
+      print *,' ANISOTROP:',zllmgam
+      print *,'  ANGLE:',zminthe,zllmthe
+      print *,'  pic:',zllmpic
+      print *,'  val:',zllmval
+      
+C
+c gamma and theta a 1. and 0. at poles
+c
+      DO jj=1,jmar
+      zmea(imar+1,jj)=zmea(1,jj)
+      zphi(imar+1,jj)=zphi(1,jj)
+      zpic(imar+1,jj)=zpic(1,jj)
+      zval(imar+1,jj)=zval(1,jj)
+      zstd(imar+1,jj)=zstd(1,jj)
+      zsig(imar+1,jj)=zsig(1,jj)
+      zgam(imar+1,jj)=zgam(1,jj)
+      zthe(imar+1,jj)=zthe(1,jj)
+      ENDDO
+
+
+      zmeanor=0.0
+      zmeasud=0.0
+      zstdnor=0.0
+      zstdsud=0.0
+      zsignor=0.0
+      zsigsud=0.0
+      zweinor=0.0
+      zweisud=0.0
+      zpicnor=0.0
+      zpicsud=0.0                                   
+      zvalnor=0.0
+      zvalsud=0.0 
+
+      DO ii=1,imar
+      zweinor=zweinor+              weight(ii,   1)
+      zweisud=zweisud+              weight(ii,jmar)
+      zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)
+      zmeasud=zmeasud+zmea(ii,jmar)*weight(ii,jmar)
+      zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)
+      zstdsud=zstdsud+zstd(ii,jmar)*weight(ii,jmar)
+      zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)
+      zsigsud=zsigsud+zsig(ii,jmar)*weight(ii,jmar)
+      zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)
+      zpicsud=zpicsud+zpic(ii,jmar)*weight(ii,jmar)
+      zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)
+      zvalsud=zvalsud+zval(ii,jmar)*weight(ii,jmar)
+      ENDDO
+
+      DO ii=1,imar+1
+      zmea(ii,   1)=zmeanor/zweinor
+      zmea(ii,jmar)=zmeasud/zweisud
+      zphi(ii,   1)=zmeanor/zweinor
+      zphi(ii,jmar)=zmeasud/zweisud
+      zpic(ii,   1)=zpicnor/zweinor
+      zpic(ii,jmar)=zpicsud/zweisud
+      zval(ii,   1)=zvalnor/zweinor
+      zval(ii,jmar)=zvalsud/zweisud
+      zstd(ii,   1)=zstdnor/zweinor
+      zstd(ii,jmar)=zstdsud/zweisud
+      zsig(ii,   1)=zsignor/zweinor
+      zsig(ii,jmar)=zsigsud/zweisud
+      zgam(ii,   1)=1.
+      zgam(ii,jmar)=1.
+      zthe(ii,   1)=0.
+      zthe(ii,jmar)=0.
+      ENDDO
+
+      RETURN
+      END
+
+      SUBROUTINE MVA9(X,IMAR,JMAR)
+
+C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
+
+      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
+      real WEIGHTpb(-1:1,-1:1)
+
+
+      SUM=0.
+      DO IS=-1,1
+        DO JS=-1,1
+          WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2))
+          SUM=SUM+WEIGHTpb(IS,JS)
+        ENDDO
+      ENDDO
+      
+c     WRITE(*,*) 'MVA9 ', IMAR, JMAR
+c     WRITE(*,*) 'MVA9 ', WEIGHTpb
+c     WRITE(*,*) 'MVA9 SUM ', SUM
+      DO IS=-1,1
+        DO JS=-1,1
+          WEIGHTpb(IS,JS)=WEIGHTpb(IS,JS)/SUM
+        ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+        DO I=2,IMAR-1
+          XF(I,J)=0.
+          DO IS=-1,1
+            DO JS=-1,1
+              XF(I,J)=XF(I,J)+X(I+IS,J+JS)*WEIGHTpb(IS,JS)
+            ENDDO
+          ENDDO
+        ENDDO
+      ENDDO
+
+      DO J=2,JMAR-1
+        XF(1,J)=0.
+        IS=IMAR-1
+        DO JS=-1,1 
+          XF(1,J)=XF(1,J)+X(IS,J+JS)*WEIGHTpb(-1,JS)
+        ENDDO
+        DO IS=0,1 
+          DO JS=-1,1 
+            XF(1,J)=XF(1,J)+X(1+IS,J+JS)*WEIGHTpb(IS,JS)
+          ENDDO
+        ENDDO
+        XF(IMAR,J)=XF(1,J)
+      ENDDO
+
+      DO I=1,IMAR
+        XF(I,1)=XF(I,2)
+        XF(I,JMAR)=XF(I,JMAR-1)
+      ENDDO
+
+      DO I=1,IMAR
+        DO J=1,JMAR
+          X(I,J)=XF(I,J)
+        ENDDO
+      ENDDO
+
+      RETURN
+      END
+
+
+
Index: trunk/LMDZ.TITAN/libf/phytitan/gwprofil.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/gwprofil.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/gwprofil.F	(revision 1056)
@@ -0,0 +1,223 @@
+      subroutine gwprofil
+     *         ( nlon, nlev
+     *         , kgwd ,kdx  , ktest
+     *         , kkcrit, kkcrith, kcrit ,  kkenvh, kknu,kknu2
+     *         , paphm1, prho   , pstab , ptfr , pvph , pri , ptau
+     *         , pdmod   , pnu   , psig ,pgamma, pstd, ppic,pval)
+
+C**** *gwprofil*
+C
+C     purpose.
+C     --------
+C
+C**   interface.
+C     ----------
+C          from *gwdrag*
+C
+C        explicit arguments :
+C        --------------------
+C     ==== inputs ===
+C
+C     ==== outputs ===
+C
+C        implicit arguments :   none
+C        --------------------
+C
+C     method:
+C     -------
+C     the stress profile for gravity waves is computed as follows:
+C     it decreases linearly with heights from the ground 
+C     to the low-level indicated by kkcrith,
+C     to simulates lee waves or 
+C     low-level gravity wave breaking.
+C     above it is constant, except when the waves encounter a critical
+C     level (kcrit) or when they break.
+C     The stress is also uniformly distributed above the level
+C     ntop.                                          
+C
+      use dimphy
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+C-----------------------------------------------------------------------
+C
+C*       0.1   ARGUMENTS
+C              ---------
+C
+      integer nlon,nlev,kgwd
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon)
+     *       ,kdx(nlon),ktest(nlon)
+     *       ,kkenvh(nlon),kknu(nlon),kknu2(nlon)
+C
+      real paphm1(nlon,nlev+1), pstab(nlon,nlev+1),
+     *     prho  (nlon,nlev+1), pvph (nlon,nlev+1),
+     *     pri   (nlon,nlev+1), ptfr (nlon), ptau(nlon,nlev+1)
+     
+      real pdmod (nlon) , pnu (nlon) , psig(nlon),
+     *     pgamma(nlon) , pstd(nlon) , ppic(nlon), pval(nlon)
+     
+C-----------------------------------------------------------------------
+C
+C*       0.2   local arrays
+C              ------------
+C
+      integer jl,jk
+      real zsqr,zalfa,zriw,zdel,zb,zalpha,zdz2n,zdelp,zdelpt
+
+      real zdz2 (klon,klev) , znorm(klon) , zoro(klon)
+      real ztau (klon,klev+1)
+C
+C-----------------------------------------------------------------------
+C
+C*         1.    INITIALIZATION
+C                --------------
+C
+C      print *,' entree gwprofil' 
+ 100  CONTINUE
+C
+C
+C*    COMPUTATIONAL CONSTANTS.
+C     ------------- ----------
+C
+      do 400 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+      zoro(jl)=psig(jl)*pdmod(jl)/4./pstd(jl)
+      ztau(jl,klev+1)=ptau(jl,klev+1)
+c     print *,jl,ptau(jl,klev+1)
+      ztau(jl,kkcrith(jl))=grahilo*ptau(jl,klev+1)
+      endif
+  400 continue
+  
+C
+      do 430 jk=klev+1,1,-1
+C
+C
+C*         4.1    constant shear stress until top of the
+C                 low-level breaking/trapped layer
+  410 CONTINUE
+C
+      do 411 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+           if(jk.gt.kkcrith(jl)) then
+           zdelp=paphm1(jl,jk)-paphm1(jl,klev+1) 
+           zdelpt=paphm1(jl,kkcrith(jl))-paphm1(jl,klev+1) 
+           ptau(jl,jk)=ztau(jl,klev+1)+zdelp/zdelpt*
+     c                 (ztau(jl,kkcrith(jl))-ztau(jl,klev+1))
+           else                    
+           ptau(jl,jk)=ztau(jl,kkcrith(jl))
+           endif
+       endif
+ 411  continue             
+C
+C*         4.15   constant shear stress until the top of the
+C                 low level flow layer.
+ 415  continue
+C        
+C
+C*         4.2    wave displacement at next level.
+C
+  420 continue
+C
+  430 continue
+
+C
+C*         4.4    wave richardson number, new wave displacement
+C*                and stress:  breaking evaluation and critical 
+C                 level
+C
+                          
+      do 440 jk=klev,1,-1
+
+      do 441 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+      znorm(jl)=prho(jl,jk)*sqrt(pstab(jl,jk))*pvph(jl,jk)
+      zdz2(jl,jk)=ptau(jl,jk)/amax1(znorm(jl),gssec)/zoro(jl)
+      endif
+  441 continue
+
+      do 442 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+          if(jk.lt.kkcrith(jl)) then
+          if((ptau(jl,jk+1).lt.gtsec).or.(jk.le.kcrit(jl))) then
+             ptau(jl,jk)=0.0
+          else
+               zsqr=sqrt(pri(jl,jk))
+               zalfa=sqrt(pstab(jl,jk)*zdz2(jl,jk))/pvph(jl,jk)
+               zriw=pri(jl,jk)*(1.-zalfa)/(1+zalfa*zsqr)**2
+               if(zriw.lt.grcrit) then
+c                 print *,' breaking!!!',ptau(jl,jk),zsqr
+                  zdel=4./zsqr/grcrit+1./grcrit**2+4./grcrit
+                  zb=1./grcrit+2./zsqr
+                  zalpha=0.5*(-zb+sqrt(zdel))
+                  zdz2n=(pvph(jl,jk)*zalpha)**2/pstab(jl,jk)
+                  ptau(jl,jk)=znorm(jl)*zdz2n*zoro(jl)
+               endif
+                
+               ptau(jl,jk)=amin1(ptau(jl,jk),ptau(jl,jk+1))
+                  
+          endif
+          endif
+      endif
+  442 continue
+  440 continue
+
+C  REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
+
+      do 530 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+         ztau(jl,kkcrith(jl)-1)=ptau(jl,kkcrith(jl)-1)
+         ztau(jl,ntop)=ptau(jl,ntop)
+      endif
+ 530  continue      
+
+      do 531 jk=1,klev
+      
+      do 532 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+                
+         if(jk.gt.kkcrith(jl)-1)then
+
+          zdelp=paphm1(jl,jk)-paphm1(jl,klev+1    )
+          zdelpt=paphm1(jl,kkcrith(jl)-1)-paphm1(jl,klev+1    )
+          ptau(jl,jk)=ztau(jl,klev+1    ) +
+     .                (ztau(jl,kkcrith(jl)-1)-ztau(jl,klev+1    ) )*
+     .                zdelp/zdelpt
+     
+        endif
+      endif
+            
+ 532  continue    
+ 
+C  REORGANISATION AT THE MODEL TOP....
+
+      do 533 jl=kidia,kfdia
+      if(ktest(jl).eq.1)then
+
+         if(jk.lt.ntop)then
+
+          zdelp =paphm1(jl,ntop)
+          zdelpt=paphm1(jl,jk)
+          ptau(jl,jk)=ztau(jl,ntop)*zdelpt/zdelp 
+c         ptau(jl,jk)=ztau(jl,ntop)                
+
+        endif
+
+      endif
+
+ 533  continue
+
+ 
+ 531  continue        
+
+
+ 123   format(i4,1x,20(f6.3,1x))
+
+
+      return
+      end
+
Index: trunk/LMDZ.TITAN/libf/phytitan/gwstress.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/gwstress.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/gwstress.F	(revision 1056)
@@ -0,0 +1,146 @@
+      SUBROUTINE gwstress
+     *         (  nlon  , nlev
+     *         , kkcrit, ksect, kkhlim, ktest, kkcrith, kcrit, kkenvh
+     *         , kknu
+     *         , prho  , pstab , pvph  , pstd, psig
+     *         , pmea , ppic , pval  , ptfr  , ptau  
+     *         , pgeom1 , pgamma , pd1  , pd2   , pdmod , pnu )
+c
+c**** *gwstress*
+c
+c     purpose.
+c     --------
+c  Compute the surface stress due to Gravity Waves, according
+c  to the Phillips (1979) theory of 3-D flow above 
+c  anisotropic elliptic ridges.
+
+C  The stress is reduced two account for cut-off flow over
+C  hill.  The flow only see that part of the ridge located
+c  above the blocked layer (see zeff).
+c
+c**   interface.
+c     ----------
+c     call *gwstress*  from *gwdrag*
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c     ==== outputs ===
+c
+c        implicit arguments :   none
+c        --------------------
+c
+c     method.
+c     -------
+c
+c
+c     externals.
+c     ----------
+c
+c
+c     reference.
+c     ----------
+c
+c   LOTT and MILLER (1997)  &  LOTT (1999)
+c
+c     author.
+c     -------
+c
+c     modifications.
+c     --------------
+c     f. lott put the new gwd on ifs      22/11/93
+c
+c-----------------------------------------------------------------------
+      use dimphy
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+      integer nlon,nlev
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
+     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon),kknu(nlon)
+c
+      real prho(nlon,nlev+1),pstab(nlon,nlev+1),ptau(nlon,nlev+1),
+     *     pvph(nlon,nlev+1),ptfr(nlon),
+     *     pgeom1(nlon,nlev),pstd(nlon)
+c
+      real pd1(nlon),pd2(nlon),pnu(nlon),psig(nlon),pgamma(nlon)
+      real pmea(nlon),ppic(nlon),pval(nlon)
+      real pdmod(nlon)
+c
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+c  zeff--real: effective height seen by the flow when there is blocking
+
+      integer jl
+      real zeff  
+c
+c-----------------------------------------------------------------------
+c
+c*       0.3   functions
+c              ---------
+c     ------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c      PRINT *,' in gwstress'
+ 100  continue
+c
+c*         3.1     gravity wave stress.
+c
+  300 continue
+c
+c
+      do 301 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      
+c  effective mountain height above the blocked flow
+  
+         zeff=ppic(jl)-pval(jl)
+         if(kkenvh(jl).lt.klev)then
+         zeff=amin1(GFRCRIT*pvph(jl,klev+1)/sqrt(pstab(jl,klev+1))
+     c              ,zeff)
+         endif
+
+      
+        ptau(jl,klev+1)=gkdrag*prho(jl,klev+1)
+     *     *psig(jl)*pdmod(jl)/4./pstd(jl)
+     *     *pvph(jl,klev+1)*sqrt(pstab(jl,klev+1))
+     *     *zeff**2
+
+
+c  too small value of stress or  low level flow include critical level
+c  or low level flow:  gravity wave stress nul.
+                
+c       lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
+c    *      .or.(pvph(jl,klev+1).lt.gvcrit)
+c       if(lo) ptau(jl,klev+1)=0.0
+      
+c      print *,jl,ptau(jl,klev+1)
+
+      else
+      
+          ptau(jl,klev+1)=0.0
+          
+      endif
+
+  301 continue
+
+c      write(21)(ptau(jl,klev+1),jl=kidia,kfdia)
+ 
+      return
+      end
+
+
Index: trunk/LMDZ.TITAN/libf/phytitan/ini_archive.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/ini_archive.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/ini_archive.F	(revision 1056)
@@ -0,0 +1,355 @@
+c=======================================================================
+      subroutine ini_archive(nid,phis,tab_cntrl_dyn,tab_cntrl_fi)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:  ecriture de l'entete du fichier "start_archive"
+c   -----
+c
+c	 Proche de iniwrite.F
+c
+c   Arguments:
+c   ---------
+c
+c	Inputs:
+c   ------
+c
+c       nid            unite logique du fichier "start_archive"
+c       phis           geopotentiel au sol
+c       tab_cntrl_dyn  tableau des param dynamiques
+c       tab_cntrl_fi   tableau des param physiques
+c
+
+c=======================================================================
+ 
+      USE control_mod
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "temps.h"
+#include "ener.h"
+#include "logic.h"
+#include "description.h"
+#include "serre.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c   Local:
+c   ------
+      INTEGER	length,l
+      parameter (length = 100)
+      REAL	tab_cntrl(2*length) ! tableau des parametres du run
+      INTEGER	loop
+      INTEGER	ierr, setvdim, putvdim, putdat, setname,cluvdb
+      INTEGER	setdim
+      INTEGER	ind1,indlast
+
+c   Arguments:
+c   ----------
+      REAL	phis(ip1jmp1)
+      REAL	tab_cntrl_dyn(length)
+      REAL	tab_cntrl_fi(length)
+
+!Mars --------Ajouts-----------
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3), dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_llmp1,idim_llm
+      INTEGER idim_tim
+      INTEGER nid,nvarid
+      real sig_s(llm),s(llm)
+
+      pi  = 2. * ASIN(1.)
+
+
+c-----------------------------------------------------------------------
+c   Remplissage du tableau des parametres de controle du RUN  
+c-----------------------------------------------------------------------
+
+      DO l=1,length
+         tab_cntrl(l)       = tab_cntrl_dyn(l)
+         tab_cntrl(length+l)= tab_cntrl_fi(l)
+      ENDDO
+
+c=======================================================================
+c	Ecriture NetCDF de l''entete du fichier "start_archive"
+c=======================================================================
+
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
+     .                       "Fichier start_archive")
+c
+c Definir les dimensions du fichiers:
+c
+c     CHAMPS AJOUTES POUR LA VISUALISATION T,ps, etc... avec Grads ou ferret:
+      ierr = NF_DEF_DIM (nid,"index", 2*length, idim_index)
+      ierr = NF_DEF_DIM (nid,"rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid,"rlatu", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid,"rlonv", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid,"rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid,"sigs",  llm, idim_llm)
+      ierr = NF_DEF_DIM (nid,"sig", llmp1, idim_llmp1)
+      ierr = NF_DEF_DIM (nid,"Time", NF_UNLIMITED, idim_tim)
+
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+
+c-----------------------------------------------------------------------
+c  Ecriture du tableau des parametres du run
+c-----------------------------------------------------------------------
+
+      call def_var(nid,"Time","Time","days since 00:00:00",1,
+     .            idim_tim,nvarid,ierr)
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des longitudes et latitudes
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture des niveaux verticaux
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
+     .                       "Numero naturel des couches s")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
+     .                       "Numero naturel des couches sigma")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
+     .                       "Coef A: niveaux pression hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_llmp1,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_llmp1,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 35,
+     .                       "Coefficient B niveaux sigma hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+c ----------------------
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_llm,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_llm,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture aire et coefficients de passage cov. <-> contra. <--> naturel
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+
+c-----------------------------------------------------------------------
+c  Ecriture du geopentiel au sol
+c-----------------------------------------------------------------------
+
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+
+      RETURN
+      END
Index: trunk/LMDZ.TITAN/libf/phytitan/ini_histday.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/ini_histday.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/ini_histday.h	(revision 1056)
@@ -1,177 +1,177 @@
       IF (ok_journe) THEN
-c
+
          zsto = dtime
-         zout = dtime * FLOAT(ecrit_day)
+         zout = dtime * REAL(ecrit_day)
 c zsto1: pour des flux radiatifs calcules tous les radpas appels physiq
-         zsto1= dtime * FLOAT(radpas)
-c
+         zsto1= dtime * REAL(radpas)
+
          idayref = day_ref
          CALL ymds2ju(annee_ref, 1, idayref, zero, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlond(i+jjmp1-jjm)
-            zx_lon(i,jjmp1) = rlond(i+jjmp1-jjm)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
-         CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 
+
+         CALL histbeg_phy("histday.nc", itau_phy, zjulian, dtime,
      .                 nhori, nid_day)
-         write(*,*)'Journee ', itau_phy, zjulian
-         CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
+
+!$OMP MASTER
+         CALL histvert(nid_day, "presnivs", "Vertical levels", "Pa",
      .                 klev, presnivs, nvert)
 
 c-------------------------------------------------------
       IF(lev_histday.GE.1) THEN
-c
+
 ccccccccccccc 2D fields, invariables
-c
+
          CALL histdef(nid_day, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "once",  zsto,zout)
-c
+
          CALL histdef(nid_day, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "once",  zsto,zout)
-c
+
 ccccccc axe Ls
          CALL histdef(nid_day, "ls", "Solar longitude", "degrees",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "ave(X)", zsto,zout)
+
 ccccccccccccc 2D fields, variables
-c
+
          CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_day, "ue", "Zonal energy transport", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
 c    .                "ave(X)", zsto,zout)
-c
+
 c        CALL histdef(nid_day, "ve", "Merid energy transport", "-",
-c     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
 c     .                "ave(X)", zsto,zout)
-c
+
       ENDIF !lev_histday.GE.1
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.2) THEN
-c
+
 ccccccccccccc 3D fields, basics
-c
+
          CALL histdef(nid_day, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "vitw", "Vertical wind", "Pa/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
+         CALL histdef(nid_day, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "dudyn", "Dynamics dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_day, "duvdf", "Boundary-layer dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
 cccccccccccccccccc  Tracers
-c
+
          if (iflag_trac.eq.1) THEN
           if (microfi.ge.1) then
 c           DO iq=1,nmicro
 c             CALL histdef(nid_day, tname(iq), ttext(iq), "n/m2",
-c     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
 c     .                "ave(X)", zsto,zout)
 c           ENDDO
              CALL histdef(nid_day, "qaer","nb tot aer" , "n/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
 
             if (clouds.eq.1) then
              CALL histdef(nid_day, "qnoy","nb tot noy" , "n/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
              CALL histdef(nid_day, "qgl1","V tot gl1" , "m3/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
              CALL histdef(nid_day, "qgl2","V tot gl2" , "m3/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
              CALL histdef(nid_day, "qgl3","V tot gl3" , "m3/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
 c--------------
 c ----- SATURATION ESP NUAGES
                CALL histdef(nid_day,"ch4sat", "saturation CH4", "--",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_day,"c2h6sat", "saturation C2H6", "--",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_day,"c2h2sat", "saturation C2H2", "--",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- RESERVOIR DE SURFACE
                CALL histdef(nid_day, "reserv", "Reservoir surface","m",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- ECHANGE GAZ SURF/ATM (evaporation)
                CALL histdef(nid_day, "evapch4", "Evaporation CH4","m",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- PRECIPITATIONS (precipitations cumulatives)
                CALL histdef(nid_day,"prech4","Precip CH4","m",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_day,"prec2h6","Precip C2H6",
-     .                "m",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "m",iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_day,"prec2h2","Precip C2H2",
-     .                "m",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "m",iim,jj_nb,nhori, 1,1,1, nvert, 32,
+     .                "ave(X)", zsto,zout)
+               CALL histdef(nid_day,"prenoy","Precip NOY",
+     .                "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32,
+     .                "ave(X)", zsto,zout)
+               CALL histdef(nid_day,"preaer","Precip AER",
+     .                "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- FLUX GLACE
                CALL histdef(nid_day,"flxgl1", "flux gl CH4",
-     .              "kg/m2/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
                CALL histdef(nid_day,"flxgl2", "flux gl C2H6",
-     .              "kg/m2/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
                CALL histdef(nid_day,"flxgl3", "flux gl C2H2",
-     .              "kg/m2/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
 c --------------
 c ----- RAYON DES GOUTTES
                CALL histdef(nid_day,"rcldbar", "rayon moyen goutte",
-     .                "m",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "m",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
             endif
@@ -182,183 +182,180 @@
            DO iq=nmicro+1,nqmax
          CALL histdef(nid_day, tname(iq), ttext(iq), "ppm",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
            ENDDO
 	  endif
          endif
-c
+
       ENDIF !lev_histday.GE.2
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.3) THEN
-c
+
 cccccccccccccccccc  Radiative transfer
-c
+
 c 2D
-c
+
          CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
          CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
          CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
 c 3D
-c
+
          CALL histdef(nid_day, "SWnet", "Net SW flux","W/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert,
      .                32, "ave(X)", zsto1,zout)
-c
+
          CALL histdef(nid_day, "LWnet", "Net LW flux","W/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert,
      .                32, "ave(X)", zsto1,zout)
-c
+
 c --------------
 c ----- OPACITE BRUME
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"thv"//str1,"Haze Opa Vis",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"thv"//str2,"Haze Opa Vis",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"thi"//str1,"Haze Opa IR",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"thi"//str2,"Haze Opa IR",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- EXTINCTION BRUME
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"khv"//str1,"Haze ext Vis ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"khv"//str2,"Haze ext Vis ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"khi"//str1,"Haze ext IR ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"khi"//str2,"Haze ext IR ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- OPACITE GAZ
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"tgv"//str1,"Gas Opa Vis",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"tgv"//str2,"Gas Opa Vis",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"tgi"//str1,"Gas Opa IR",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"tgi"//str2,"Gas Opa IR",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- EXTINCTION GAZ
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"kgv"//str1,"Gas ext Vis ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"kgv"//str2,"Gas ext Vis ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_day,"kgi"//str1,"Gas ext IR ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_day,"kgi"//str2,"Gas ext IR ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- OPACITE NUAGES
          if (clouds.eq.1) then
            CALL histdef(nid_day,"tcld","Cld Opa proxy",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
      .                "ave(X)",zsto,zout)
-c
+
 c --------------
 c ----- EXTINCTION NUAGES
            CALL histdef(nid_day,"kcld","Cld Ext proxy",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
      .                "ave(X)",zsto,zout)
          endif
-c
+
       ENDIF !lev_histday.GE.3
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.4) THEN
-c
+
          CALL histdef(nid_day, "dtdyn", "Dynamics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "dtphy", "Physics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "dtvdf", "Boundary-layer dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "dtajs", "Dry adjust. dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "dtswr", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_day, "dtlwr", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_day, "dtec", "Cinetic dissip dT", "K/s",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
 c    .                "ave(X)", zsto,zout)
-c
+
       ENDIF !lev_histday.GE.4
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.5) THEN
-c
-c
+
+
 c        call histdef(nid_day, "taux", 
 c    $         "Zonal wind stress", "Pa",  
-c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         iim,jj_nb,nhori, 1,1,1, nvert, 32,
 c    $         "ave(X)", zsto,zout)
-c
+
 c        call histdef(nid_day, "tauy", 
 c    $         "Meridional xind stress", "Pa",  
-c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         iim,jj_nb,nhori, 1,1,1, nvert, 32,
 c    $         "ave(X)", zsto,zout)
-c
+
 c        CALL histdef(nid_day, "cdrm", "Momentum drag coef.", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
 c    .                "ave(X)", zsto,zout)
-c
+
 c        CALL histdef(nid_day, "cdrh", "Heat drag coef.", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
 c    .                "ave(X)", zsto,zout)
-c
+
       ENDIF !lev_histday.GE.5
 c-------------------------------------------------------
-c
+
          CALL histend(nid_day)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
+
       ENDIF ! fin de test sur ok_journe
Index: trunk/LMDZ.TITAN/libf/phytitan/ini_histins.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/ini_histins.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/ini_histins.h	(revision 1056)
@@ -1,21 +1,15 @@
       IF (ok_instan) THEN
-c
-          zsto = dtime * FLOAT(ecrit_ins)
-          zout = dtime * FLOAT(ecrit_ins)
-c
+
+          zsto = dtime * REAL(ecrit_ins)
+          zout = dtime * REAL(ecrit_ins)
+
          idayref = day_ref
          CALL ymds2ju(annee_ref, 1, idayref, zero, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlond(i+jjmp1-jjm)
-            zx_lon(i,jjmp1) = rlond(i+jjmp1-jjm)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
-         CALL histbeg("histins", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
+
+         CALL histbeg_phy("histins.nc", itau_phy, zjulian, dtime,
      .                 nhori, nid_ins)
-         write(*,*)'Inst ', itau_phy, zjulian
-         CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
+
+!$OMP MASTER
+         CALL histvert(nid_ins, "presnivs", "Vertical levels", "Pa",
      .                 klev, presnivs, nvert)
 
@@ -23,93 +17,93 @@
 
       IF(lev_histday.GE.1) THEN
-c
+
 ccccccccccccc 2D fields, invariables
-c
+
          CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "once",  zsto,zout)
-c
+
          CALL histdef(nid_ins, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "once",  zsto,zout)
-c
+
 ccccccc axe Ls
          CALL histdef(nid_ins, "ls", "Solar longitude", "degrees",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
 ccccccccccccc 2D fields, variables
-c
+
          CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "ue", "Zonal energy transport", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "ve", "Merid energy transport", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "inst(X)", zsto,zout)
+
       ENDIF !lev_histday.GE.1
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.2) THEN
-c
+
 ccccccccccccc 3D fields, basics
-c
+
          CALL histdef(nid_ins, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "vitw", "Vertical wind", "Pa/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "duvdf", "Boundary-layer dU", "m/s2",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "dudyn", "Dynamics dU", "m/s2",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "inst(X)", zsto,zout)
+
       ENDIF !lev_histday.GE.2
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.3) THEN
-c
+
 cccccccccccccccccc  Tracers
-c
+
          if (iflag_trac.eq.1) THEN
           if (microfi.ge.1) then
            DO iq=1,nmicro
          CALL histdef(nid_ins, tname(iq), ttext(iq), "n/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "inst(X)", zsto,zout)
            ENDDO
@@ -118,168 +112,165 @@
            DO iq=nmicro+1,nqmax
          CALL histdef(nid_ins, tname(iq), ttext(iq), "ppm",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "inst(X)", zsto,zout)
            ENDDO
 	  endif
          endif
-c
+
 cccccccccccccccccc  Radiative transfer
-c
+
 c 2D
-c
+
          CALL histdef(nid_ins, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "inst(X)", zsto,zout)
+
 c 3D
-c
+
          CALL histdef(nid_ins, "SWnet", "Net SW flux","W/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert,
      .                32, "inst(X)", zsto,zout)
-c
+
          CALL histdef(nid_ins, "LWnet", "Net LW flux","W/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert,
      .                32, "inst(X)", zsto,zout)
-c
+
 c --------------
 c ----- OPACITE BRUME
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"thv"//str1,"Haze Opa Vis",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
-         DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"thi"//str1,"Haze Opa IR",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"thv"//str2,"Haze Opa Vis",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
+         DO k=8,NSPECI,10
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"thi"//str2,"Haze Opa IR",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
 c --------------
 c ----- EXTINCTION BRUME
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"khv"//str1,"Haze ext Vis ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
-         DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"khi"//str1,"Haze ext IR ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"khv"//str2,"Haze ext Vis ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
+         DO k=8,NSPECI,10
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"khi"//str2,"Haze ext IR ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
 c --------------
 c ----- OPACITE GAZ
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"tgv"//str1,"Haze Opa Vis",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
-         DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"tgi"//str1,"Haze Opa IR",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"tgv"//str2,"Haze Opa Vis",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
+         DO k=8,NSPECI,10
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"tgi"//str2,"Haze Opa IR",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
 c --------------
 c ----- EXTINCTION GAZ
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"kgv"//str1,"Haze ext Vis ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
-         DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_ins,"kgi"//str1,"Haze ext IR ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ins(X)",zsto,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"kgv"//str2,"Haze ext Vis ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
+         DO k=8,NSPECI,10
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_ins,"kgi"//str2,"Haze ext IR ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ins(X)",zsto,zout)
+         ENDDO
+
       ENDIF !lev_histday.GE.3
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.4) THEN
-c
+
          CALL histdef(nid_ins, "dtdyn", "Dynamics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "dtphy", "Physics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "dtajs", "Dry adjust. dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "dtswr", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
          CALL histdef(nid_ins, "dtlwr", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "inst(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "dtec", "Cinetic dissip dT", "K/s",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "dvvdf", "Boundary-layer dV", "m/s2",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "inst(X)", zsto,zout)
+
       ENDIF !lev_histday.GE.4
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.5) THEN
-c
-c
+
+
 c        call histdef(nid_ins, "taux", 
 c    $         "Zonal wind stress", "Pa",  
-c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         iim,jj_nb,nhori, 1,1,1, nvert, 32,
 c    $         "inst(X)", zsto,zout)
-c
+
 c        call histdef(nid_ins, "tauy", 
 c    $         "Meridional xind stress", "Pa",  
-c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         iim,jj_nb,nhori, 1,1,1, nvert, 32,
 c    $         "inst(X)", zsto,zout)
-c
+
 c        CALL histdef(nid_ins, "cdrm", "Momentum drag coef.", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "inst(X)", zsto,zout)
+
 c        CALL histdef(nid_ins, "cdrh", "Heat drag coef.", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "inst(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "inst(X)", zsto,zout)
+
       ENDIF !lev_histday.GE.5
 c-------------------------------------------------------
 
          CALL histend(nid_ins)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
+
       ENDIF
Index: trunk/LMDZ.TITAN/libf/phytitan/ini_histmth.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/ini_histmth.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/ini_histmth.h	(revision 1056)
@@ -1,198 +1,192 @@
       IF (ok_mensuel) THEN
-c
+
          zsto = dtime
-         zout = dtime * FLOAT(ecrit_mth)
+         zout = dtime * REAL(ecrit_mth)
 c zsto1: pour des flux radiatifs calcules tous les radpas appels physiq
-         zsto1= dtime * FLOAT(radpas)
-c
+         zsto1= dtime * REAL(radpas)
+
          idayref = day_ref
          CALL ymds2ju(annee_ref, 1, idayref, zero, zjulian)
-c
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlond,zx_lon)
-         DO i = 1, iim
-            zx_lon(i,1) = rlond(i+jjmp1-jjm)
-            zx_lon(i,jjmp1) = rlond(i+jjmp1-jjm)
-         ENDDO
-         CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlatd,zx_lat)
-         CALL histbeg("histmth", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
-     .                 1,iim,1,jjmp1, itau_phy, zjulian, dtime, 
+
+         CALL histbeg_phy("histmth.nc", itau_phy, zjulian, dtime,
      .                 nhori, nid_mth)
-         write(*,*)'Journee ', itau_phy, zjulian
-         CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
+
+!$OMP MASTER
+         CALL histvert(nid_mth, "presnivs", "Vertical levels", "Pa",
      .                 klev, presnivs, nvert)
 
 c-------------------------------------------------------
       IF(lev_histmth.GE.1) THEN
-c
+
 ccccccccccccc 2D fields, invariables
-c
+
          CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "once",  zsto,zout)
-c
+
          CALL histdef(nid_mth, "aire", "Grid area", "-",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "once",  zsto,zout)
-c
+
 ccccccc axe Ls
          CALL histdef(nid_mth, "ls", "Solar longitude", "degrees",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "ave(X)", zsto,zout)
+
 ccccccccccccc 2D fields, variables
-c
+
          CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+     .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "ave(X)", zsto,zout)
-c
-c        CALL histdef(nid_mth, "cdragh", "Drag coef on T", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "ave(X)", zsto,zout)
-c
-c        CALL histdef(nid_mth, "cdragm", "Drag coef on U", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "ave(X)", zsto,zout)
+
       ENDIF !lev_histmth.GE.1
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.2) THEN
-c
+
 ccccccccccccc 3D fields, basics
-c
+
          CALL histdef(nid_mth, "temp", "Air temperature", "K",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "geop", "Geopotential height", "m",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "vitw", "Vertical wind", "Pa/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_mth, "Kz", "vertical diffusion coef", "m2/s",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
+         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
+         CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2",
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
 cccccccccccccccccc  Tracers
-c
+
          if (iflag_trac.eq.1) THEN
           if (microfi.ge.1) then
 c           DO iq=1,nmicro
 c             CALL histdef(nid_mth, tname(iq), ttext(iq), "n/m2",
-c     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
 c     .                "ave(X)", zsto,zout)
 c           ENDDO
              CALL histdef(nid_mth, "qaer","nb tot aer" , "n/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
 
             if (clouds.eq.1) then
              CALL histdef(nid_mth, "qnoy","nb tot noy" , "n/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
              CALL histdef(nid_mth, "qgl1","V tot gl1" , "m3/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
              CALL histdef(nid_mth, "qgl2","V tot gl2" , "m3/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
              CALL histdef(nid_mth, "qgl3","V tot gl3" , "m3/m2",
-     .                    iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                    iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                    "ave(X)", zsto,zout)
 c--------------
 c ----- SATURATION ESP NUAGES
                CALL histdef(nid_mth,"ch4sat", "saturation CH4", "--",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"c2h6sat", "saturation C2H6", "--",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"c2h2sat", "saturation C2H2", "--",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- RESERVOIR DE SURFACE
                CALL histdef(nid_mth, "reserv", "Reservoir surface","m",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- ECHANGE GAZ SURF/ATM (evaporation)
                CALL histdef(nid_mth, "evapch4", "Evaporation CH4","m",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- PRECIPITATIONS (precipitations moyennes)
                CALL histdef(nid_mth,"prech4","Precip CH4","um/s",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"prec2h6","Precip C2H6",
-     .                "um/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"prec2h2","Precip C2H2",
-     .                "um/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"prenoy","Precip NOY",
-     .                "um/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"preaer","Precip AER",
-     .                "um/s",iim,jjmp1,nhori, 1,1,1, -99, 32,
+     .                "um/s",iim,jj_nb,nhori, 1,1,1, nvert, 32,
      .                "ave(X)", zsto,zout)
 c --------------
 c ----- FLUX GLACE
                CALL histdef(nid_mth,"flxgl1", "flux gl CH4",
-     .              "kg/m2/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"flxgl2", "flux gl C2H6",
-     .              "kg/m2/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"flxgl3", "flux gl C2H2",
-     .              "kg/m2/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "kg/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
 c --------------
 c ----- Source/puits GLACE
                CALL histdef(nid_mth,"solch4", "dQ gl CH4",
-     .              "m3/m3",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "m3/m3",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"solc2h6", "dQ gl C2H6",
-     .              "m3/m3",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "m3/m3",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
                CALL histdef(nid_mth,"solc2h2", "dQ gl C2H2",
-     .              "m3/m3",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .              "m3/m3",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .              "ave(X)", zsto,zout)
 c --------------
 c ----- RAYON DES GOUTTES
                CALL histdef(nid_mth,"rcldbar", "rayon moyen goutte",
-     .                "m",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                "m",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
             endif
@@ -203,5 +197,5 @@
            DO iq=nmicro+1,nqmax
          CALL histdef(nid_mth, tname(iq), ttext(iq), "ppm",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
      .                "ave(X)", zsto,zout)
            ENDDO
@@ -209,204 +203,193 @@
 c          DO iq=nmicro+1,nqmax
 c        CALL histdef(nid_mth, "c_"//tname(iq), "c_"//ttext(iq),
-c    .        "ppm/s",iim,jjmp1,nhori, klev,1,klev,nvert, 32,
+c    .        "ppm/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
 c    .                "ave(X)", zsto,zout)
 c          ENDDO
 	  endif
          endif
-c
+
       ENDIF !lev_histmth.GE.2
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.3) THEN
-c
+
 cccccccccccccccccc  Radiative transfer
-c
+
 c 2D
-c
+
          CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
          CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
          CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
-     .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
+     .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
      .                "ave(X)", zsto1,zout)
-c
+
 c 3D
-c
+
          CALL histdef(nid_mth, "SWnet", "Net SW flux","W/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert,
      .                32, "ave(X)", zsto1,zout)
-c
+
          CALL histdef(nid_mth, "LWnet", "Net LW flux","W/m2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert,
+     .                iim,jj_nb,nhori, klev,1,klev,nvert,
      .                32, "ave(X)", zsto1,zout)
-c
+
 c --------------
 c ----- OPACITE BRUME
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"thv"//str1,"Haze Opa Vis",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"thv"//str2,"Haze Opa Vis",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"thi"//str1,"Haze Opa IR",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"thi"//str2,"Haze Opa IR",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- EXTINCTION BRUME
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"khv"//str1,"Haze ext Vis ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"khv"//str2,"Haze ext Vis ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"khi"//str1,"Haze ext IR ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"khi"//str2,"Haze ext IR ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- OPACITE GAZ
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"tgv"//str1,"Gas Opa Vis",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"tgv"//str2,"Gas Opa Vis",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"tgi"//str1,"Haze Opa IR",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"tgi"//str2,"Haze Opa IR",
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- EXTINCTION GAZ
          DO k=7,NSPECV,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"kgv"//str1,"Gas ext Vis ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"kgv"//str2,"Gas ext Vis ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
          DO k=8,NSPECI,10
-           write(str1,'(i2.2)') k
-         CALL histdef(nid_mth,"kgi"//str1,"Gas ext IR ",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
-     .                "ave(X)",zsto1,zout)
-         ENDDO
-c
+           write(str2,'(i2.2)') k
+         CALL histdef(nid_mth,"kgi"//str2,"Gas ext IR ",
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
+     .                "ave(X)",zsto1,zout)
+         ENDDO
+
 c --------------
 c ----- OPACITE NUAGES
          if (clouds.eq.1) then
            CALL histdef(nid_mth,"tcld","Cld Opa proxy",
-     .                "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
+     .                "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
      .                "ave(X)",zsto,zout)
-c
+
 c --------------
 c ----- EXTINCTION NUAGES
            CALL histdef(nid_mth,"kcld","Cld Ext proxy",
-     .                "m-1",iim,jjmp1,nhori,klev,1,klev,nvert,32,
+     .                "m-1",iim,jj_nb,nhori,klev,1,klev,nvert,32,
      .                "ave(X)",zsto,zout)
          endif
-c
+
 c --------------
 c ----- OCCURENCE NUAGES
            do k=1,12
-             write(str1,'(i2.2)') k
-             CALL histdef(nid_mth,"occcld"//str1,"occ cld",
-     .       "--",iim,jjmp1,nhori,klev,1,klev,nvert,32,
+             write(str2,'(i2.2)') k
+             CALL histdef(nid_mth,"occcld"//str2,"occ cld",
+     .       "--",iim,jj_nb,nhori,klev,1,klev,nvert,32,
      .       "ave(X)",zsto,zout)
            enddo
-c
+
       ENDIF !lev_histmth.GE.3
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.4) THEN
-c
+
          CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "dtphy", "Physics dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
          CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+     .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_mth, "dtec", "Cinetic dissip dT", "K/s",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
-         CALL histdef(nid_mth, "dudyn", "Dynamics dU", "m/s2",
-     .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-     .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
-c    .                iim,jjmp1,nhori, klev,1,klev,nvert, 32,
-c    .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
+c    .                "ave(X)", zsto,zout)
+
       ENDIF !lev_histmth.GE.4
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.5) THEN
-c
-c
+
+
 c        call histdef(nid_mth, "taux", 
 c    $         "Zonal wind stress", "Pa",  
-c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         iim,jj_nb,nhori, 1,1,1, nvert, 32,
 c    $         "ave(X)", zsto,zout)
-c
+
 c        call histdef(nid_mth, "tauy", 
 c    $         "Meridional xind stress", "Pa",  
-c    $         iim,jjmp1,nhori, 1,1,1, -99, 32,
+c    $         iim,jj_nb,nhori, 1,1,1, nvert, 32,
 c    $         "ave(X)", zsto,zout)
-c
+
 c        CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "ave(X)", zsto,zout)
+
 c        CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
-c    .                iim,jjmp1,nhori, 1,1,1, -99, 32, 
-c    .                "ave(X)", zsto,zout)
-c
+c    .                iim,jj_nb,nhori, 1,1,1, nvert, 32, 
+c    .                "ave(X)", zsto,zout)
+
       ENDIF !lev_histmth.GE.5
 c-------------------------------------------------------
-c
+
          CALL histend(nid_mth)
-c
-         ndex2d = 0
-         ndex3d = 0
-c
+
       ENDIF ! fin de test sur ok_journe
Index: trunk/LMDZ.TITAN/libf/phytitan/iniphysiq.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/iniphysiq.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/iniphysiq.F	(revision 1056)
@@ -43,43 +43,86 @@
 c   -------------
  
-      use dimphy
-      USE comgeomphy
+      USE dimphy, only : klev
+      USE mod_grid_phy_lmdz, only : klon_glo
+      USE mod_phys_lmdz_para, only : klon_omp,klon_omp_begin,
+     &                               klon_omp_end,klon_mpi_begin
+      USE comgeomphy, only : airephy,cuphy,cvphy,rlond,rlatd
       IMPLICIT NONE
-#include "dimensions.h"
+#include "iniprint.h"
 
-      REAL prad,pg,pr,pcpp,punjours
+      REAL,INTENT(IN) :: prad ! radius of the planet (m)
+      REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
+      REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
+      REAL,INTENT(IN) :: pcpp ! specific heat Cp
+      REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
+      INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics
+      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
+      REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid
+      REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid
+      REAL,INTENT(IN) :: parea(klon_glo) ! area (m2)
+      REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
+      REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
+      INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation
+      REAL,INTENT(IN) :: ptimestep !physics time step (s)
       INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
-      INTEGER ngrid,nlayer
-      REAL plat(ngrid),plon(ngrid),parea(klon),pcu(klon),pcv(klon)
-      INTEGER pdayref
- 
-      REAL ptimestep
+
+      INTEGER :: ibegin,iend,offset
+      CHARACTER (LEN=20) :: modname='iniphysiq'
+      CHARACTER (LEN=80) :: abort_message
  
       IF (nlayer.NE.klev) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimensions :'
-         PRINT*,'nlayer     = ',nlayer
-         PRINT*,'klev   = ',klev
-         STOP
+         write(lunout,*) 'STOP in ',trim(modname)
+         write(lunout,*) 'Problem with dimensions :'
+         write(lunout,*) 'nlayer     = ',nlayer
+         write(lunout,*) 'klev   = ',klev
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       ENDIF
 
-      IF (ngrid.NE.klon) THEN
-         PRINT*,'STOP in inifis'
-         PRINT*,'Probleme de dimensions :'
-         PRINT*,'ngrid     = ',ngrid
-         PRINT*,'klon   = ',klon
-         STOP
+      IF (ngrid.NE.klon_glo) THEN
+         write(lunout,*) 'STOP in ',trim(modname)
+         write(lunout,*) 'Problem with dimensions :'
+         write(lunout,*) 'ngrid     = ',ngrid
+         write(lunout,*) 'klon   = ',klon_glo
+         abort_message = ''
+         CALL abort_gcm (modname,abort_message,1)
       ENDIF
 
-      airephy=parea
-      cuphy=pcu
-      cvphy=pcv
-      rlond = plon
-      rlatd = plat
+c$OMP PARALLEL PRIVATE(ibegin,iend) 
+c$OMP+         SHARED(parea,pcu,pcv,plon,plat)
+      
+      offset=klon_mpi_begin-1
+      airephy(1:klon_omp)=parea(offset+klon_omp_begin:
+     &                          offset+klon_omp_end)
+      cuphy(1:klon_omp)=pcu(offset+klon_omp_begin:offset+klon_omp_end)
+      cvphy(1:klon_omp)=pcv(offset+klon_omp_begin:offset+klon_omp_end)
+      rlond(1:klon_omp)=plon(offset+klon_omp_begin:offset+klon_omp_end)
+      rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
 
       call suphec
+
+c$OMP END PARALLEL
+
 c     print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
 c     print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
 
+c      print*,'agagagagagagagagaga'
+c      print*,'klon_mpi_begin =', klon_mpi_begin
+c      print*,'klon_mpi_end =', klon_mpi_end
+c      print*,'klon_mpi =', klon_mpi
+c      print*,'klon_mpi_para_nb =', klon_mpi_para_nb
+c      print*,'klon_mpi_para_begin =', klon_mpi_para_begin
+c      print*,'klon_mpi_para_end  =', klon_mpi_para_end
+c      print*,'mpi_rank =', mpi_rank
+c      print*,'mpi_size =', mpi_size
+c      print*,'mpi_root =', mpi_root
+c      print*,'klon_glo =', klon_glo
+c      print*,'is_mpi_root =',is_mpi_root
+c      print*,'is_omp_root =',is_omp_root
+
+! pas d'inifis ici... 
+! est-ce que cursor est utile ? Voir avec Aymeric
+!      cursor = klon_mpi_begin
+!      print*, "CURSOR !!!!", mpi_rank, cursor
 
       RETURN
Index: trunk/LMDZ.TITAN/libf/phytitan/init_phys_lmdz.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/init_phys_lmdz.F90	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/init_phys_lmdz.F90	(revision 1056)
@@ -3,6 +3,9 @@
 !
 SUBROUTINE init_phys_lmdz(iim,jjp1,llm,nb_proc,distrib)
+  USE mod_phys_lmdz_para
   USE mod_grid_phy_lmdz
-  USE dimphy
+  USE dimphy, ONLY : init_dimphy
+  USE infotrac, ONLY : type_trac
+
   IMPLICIT NONE
   
@@ -15,5 +18,8 @@
 
     CALL init_grid_phy_lmdz(iim,jjp1,llm)
-    CALL init_dimphy(klon_glo,nbp_lev)
+    CALL init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL init_dimphy(klon_omp,nbp_lev)
+!$OMP END PARALLEL
  
 END SUBROUTINE init_phys_lmdz  
Index: trunk/LMDZ.TITAN/libf/phytitan/interface_surf.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/interface_surf.F90	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/interface_surf.F90	(revision 1056)
@@ -45,4 +45,5 @@
       & tsol_rad, tsurf_new, alb_new)
 
+      use write_field_phy
       use cpdet_mod, only: cpdet
 
@@ -159,4 +160,8 @@
            CALL soil(dtime, knon, tsurf, tsoil,soilcap, soilflux)
            cal(1:knon) = zcp(1:knon) / soilcap(1:knon)
+! for tests:
+!  call writefield_phy('interfsurf_hq_zcp',zcp,1)
+!  call writefield_phy('interfsurf_hq_cal',cal,1)
+!  call writefield_phy('interfsurf_hq_soilcap',soilcap,1)
 !       print*,"DIAGNOSTIC SOIL"
 !       print*,"soilcap=",soilcap
@@ -191,4 +196,5 @@
      & tsurf_new, fluxsens, dflux_s)
 
+  use write_field_phy
   use cpdet_mod, only: t2tpot, tpot2t
 
@@ -326,4 +332,9 @@
   ENDDO
 
+! for tests: write output fields...
+!  call writefield_phy('calcul_fluxs_d_ts',d_ts,1)
+!  call writefield_phy('calcul_fluxs_fluxsens',fluxsens,1)
+!  call writefield_phy('calcul_fluxs_dflux_s',dflux_s,1)
+
   END SUBROUTINE calcul_fluxs
 !
Index: trunk/LMDZ.TITAN/libf/phytitan/interp_vert.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/interp_vert.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/interp_vert.F	(revision 1056)
@@ -0,0 +1,84 @@
+c******************************************************
+      SUBROUTINE   interp_vert(varo,varn,lmo,lmn,apo,bpo,
+     &             ap,bp,ps,Nhoriz)
+c
+c interpolation lineaire pour passer
+c a une nouvelle discretisation verticale pour
+c les variables de GCM
+c Francois Forget (01/1995)
+c Modif pour coordonnees hybrides FF (03/2003)
+c modif pour entrees avec ap et bp au lieu de aps et bps (SL,2007)
+c**********************************************************
+
+      IMPLICIT NONE
+
+c   Declarations:
+c ==============
+c
+c  ARGUMENTS
+c  """""""""
+
+       integer lmo ! dimensions ancienne couches (input)
+       integer lmn ! dimensions nouvelle couches (input)
+
+       real apo(lmo+1),bpo(lmo+1)! anciennes coord hybrides interlayer (input)
+       real ap(lmn+1), bp(lmn+1)! nouvelles coord hybrides (interlayer) (input)
+
+       integer Nhoriz ! nombre de point horizontale (input)
+       real ps(nhoriz) !pression de surface (input)
+
+       real varo(Nhoriz,lmo) ! var dans l''ancienne grille (input)
+       real varn(Nhoriz,lmn) ! var dans la nouvelle grille (output)
+
+c Autres variables
+c """"""""""""""""
+       integer n, ln ,lo 
+       real coef
+       REAL sigmo(lmo) ! niveau sigma des variables dans les anciennes coord
+       REAL sigmn(lmn) ! niveau sigma des variables dans les nouvelles coord
+
+       real apso(lmo),bpso(lmo)! anciennes coord hybrides midlayer 
+       real aps(lmn), bps(lmn)! nouvelles coord hybrides (midlayer)
+
+c run
+c ====
+
+        do ln=1,lmn
+            aps(ln)=(ap(ln)+ap(ln+1))/2.
+            bps(ln)=(bp(ln)+bp(ln+1))/2.
+        end do
+        do lo=1,lmo
+            apso(lo)=(apo(lo)+apo(lo+1))/2.
+            bpso(lo)=(bpo(lo)+bpo(lo+1))/2.
+        end do
+
+      do n=1,Nhoriz
+
+        do ln=1,lmn
+            sigmn(ln)=aps(ln)/ps(n)+bps(ln)
+        end do
+        do lo=1,lmo
+            sigmo(lo)=apso(lo)/ps(n)+bpso(lo)
+        end do
+
+        do ln=1,lmn
+           if (sigmn(ln).ge.sigmo(1))then
+             varn(n,ln) =  varo(n,1)  
+           else if (sigmn(ln).le.sigmo(lmo)) then
+             varn(n,ln) =  varo(n,lmo)
+           else
+              do lo =1,lmo-1 
+                if ( (sigmn(ln).le.sigmo(lo)).and.
+     &             (sigmn(ln).gt.sigmo(lo+1)) )then
+                  coef = (sigmn(ln)-sigmo(lo))/(sigmo(lo+1)-sigmo(lo))
+                   varn(n,ln)=varo(n,lo) +coef*(varo(n,lo+1)-varo(n,lo))
+                end if
+              end do           
+           end if
+         end do
+
+      end do
+
+
+      return
+      end
Index: trunk/LMDZ.TITAN/libf/phytitan/iophy.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/iophy.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/iophy.F90	(revision 1056)
@@ -0,0 +1,444 @@
+!
+! $Header$
+!
+module iophy
+  
+! abd  REAL,private,allocatable,dimension(:),save :: io_lat
+! abd  REAL,private,allocatable,dimension(:),save :: io_lon
+  REAL,allocatable,dimension(:),save :: io_lat
+  REAL,allocatable,dimension(:),save :: io_lon
+  INTEGER, save :: phys_domain_id
+  INTEGER, save :: npstn
+  INTEGER, allocatable, dimension(:), save :: nptabij
+  
+  INTERFACE histwrite_phy
+    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy
+  END INTERFACE
+
+  INTERFACE histbeg_phy_all
+    MODULE PROCEDURE histbeg_phy,histbeg_phy_points
+  END INTERFACE
+
+
+contains
+
+  subroutine init_iophy_new(rlat,rlon)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE mod_grid_phy_lmdz
+  USE ioipsl
+  implicit none
+  include 'dimensions.h'   
+    real,dimension(klon),intent(in) :: rlon
+    real,dimension(klon),intent(in) :: rlat
+
+    REAL,dimension(klon_glo)        :: rlat_glo
+    REAL,dimension(klon_glo)        :: rlon_glo
+    
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+    INTEGER :: i    
+
+    CALL gather(rlat,rlat_glo)
+    CALL bcast(rlat_glo)
+    CALL gather(rlon,rlon_glo)
+    CALL bcast(rlon_glo)
+    
+!$OMP MASTER  
+    ALLOCATE(io_lat(jjm+1-1/(iim*jjm)))
+    io_lat(1)=rlat_glo(1)
+    io_lat(jjm+1-1/(iim*jjm))=rlat_glo(klon_glo)
+    IF ((iim*jjm) > 1) then
+      DO i=2,jjm
+        io_lat(i)=rlat_glo(2+(i-2)*iim)
+      ENDDO
+    ENDIF
+
+    ALLOCATE(io_lon(iim))
+    io_lon(:)=rlon_glo(2-1/(iim*jjm):iim+1-1/(iim*jjm))
+
+    ddid=(/ 1,2 /)
+    dsg=(/ iim, jjm+1-1/(iim*jjm) /)
+    dsl=(/ iim, jj_nb /)
+    dpf=(/ 1,jj_begin /)
+    dpl=(/ iim, jj_end /)
+    dhs=(/ ii_begin-1,0 /)
+    if (mpi_rank==mpi_size-1) then
+      dhe=(/0,0/)
+    else
+      dhe=(/ iim-ii_end,0 /)  
+    endif
+    
+    call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                      'APPLE',phys_domain_id)
+
+!$OMP END MASTER
+      
+  end subroutine init_iophy_new
+
+  subroutine init_iophy(lat,lon)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  use ioipsl
+  implicit none
+  include 'dimensions.h'   
+    real,dimension(iim),intent(in) :: lon
+    real,dimension(jjm+1-1/(iim*jjm)),intent(in) :: lat
+
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+
+!$OMP MASTER  
+    allocate(io_lat(jjm+1-1/(iim*jjm)))
+    io_lat(:)=lat(:)
+    allocate(io_lon(iim))
+    io_lon(:)=lon(:)
+   
+    ddid=(/ 1,2 /)
+    dsg=(/ iim, jjm+1-1/(iim*jjm) /)
+    dsl=(/ iim, jj_nb /)
+    dpf=(/ 1,jj_begin /)
+    dpl=(/ iim, jj_end /)
+    dhs=(/ ii_begin-1,0 /)
+    if (mpi_rank==mpi_size-1) then
+      dhe=(/0,0/)
+    else
+      dhe=(/ iim-ii_end,0 /)  
+    endif
+    
+    call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                      'APPLE',phys_domain_id)
+
+!$OMP END MASTER
+      
+  end subroutine init_iophy
+  
+  subroutine histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  use ioipsl
+  use write_field
+  implicit none
+  include 'dimensions.h'
+    
+    character*(*), intent(IN) :: name
+    integer, intent(in) :: itau0
+    real,intent(in) :: zjulian
+    real,intent(in) :: dtime
+    integer,intent(out) :: nhori
+    integer,intent(out) :: nid_day
+
+!$OMP MASTER    
+    if (is_sequential) then
+      call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
+                   1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
+    else
+      call histbeg(name,iim,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
+                   1,iim,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
+    endif
+!$OMP END MASTER
+  
+  end subroutine histbeg_phy
+
+  subroutine histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
+             plon,plat,plon_bounds,plat_bounds, &
+             nname,itau0,zjulian,dtime,nnhori,nnid_day)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE mod_grid_phy_lmdz
+  use ioipsl
+  use write_field
+  implicit none
+  include 'dimensions.h' 
+
+    real,dimension(klon),intent(in) :: rlon
+    real,dimension(klon),intent(in) :: rlat
+    integer, intent(in) :: itau0
+    real,intent(in) :: zjulian
+    real,intent(in) :: dtime
+    integer, intent(in) :: pim
+    integer, intent(out) :: nnhori
+    character(len=20), intent(in) :: nname
+    INTEGER, intent(out) :: nnid_day
+    integer :: i
+    REAL,dimension(klon_glo)        :: rlat_glo
+    REAL,dimension(klon_glo)        :: rlon_glo
+    INTEGER, DIMENSION(pim), intent(in)  :: tabij
+    REAL,dimension(pim), intent(in) :: plat, plon
+    INTEGER,dimension(pim), intent(in) :: ipt, jpt
+    REAL,dimension(pim,2), intent(out) :: plat_bounds, plon_bounds
+
+    INTEGER, SAVE :: tabprocbeg, tabprocend
+!$OMP THREADPRIVATE(tabprocbeg, tabprocend)
+    INTEGER :: ip
+    INTEGER, PARAMETER :: nip=1
+    INTEGER :: npproc
+    REAL, allocatable, dimension(:) :: npplat, npplon
+    REAL, allocatable, dimension(:,:) :: npplat_bounds, npplon_bounds
+    INTEGER, PARAMETER :: jjmp1=jjm+1-1/jjm
+    REAL, dimension(iim,jjmp1) :: zx_lon, zx_lat
+
+    CALL gather(rlat,rlat_glo)
+    CALL bcast(rlat_glo)
+    CALL gather(rlon,rlon_glo)
+    CALL bcast(rlon_glo)
+
+!$OMP MASTER
+    DO i=1,pim
+
+!    print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
+
+     plon_bounds(i,1)=rlon_glo(tabij(i)-1)
+     plon_bounds(i,2)=rlon_glo(tabij(i)+1)
+     if(plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
+      if(rlon_glo(tabij(i)).GE.0.) THEN
+       plon_bounds(i,2)=-1*plon_bounds(i,2)
+      endif
+     endif
+     if(plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
+      if(rlon_glo(tabij(i)).LE.0.) THEN
+       plon_bounds(i,2)=-1*plon_bounds(i,2)
+      endif
+     endif
+!
+     IF ( tabij(i).LE.iim) THEN
+      plat_bounds(i,1)=rlat_glo(tabij(i))
+     ELSE
+      plat_bounds(i,1)=rlat_glo(tabij(i)-iim)
+     ENDIF
+     plat_bounds(i,2)=rlat_glo(tabij(i)+iim)
+!
+!    print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2) 
+!    print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2) 
+!
+    ENDDO
+    if (is_sequential) then
+
+     npstn=pim
+     IF(.NOT. ALLOCATED(nptabij)) THEN
+      ALLOCATE(nptabij(pim))
+     ENDIF 
+     DO i=1,pim
+      nptabij(i)=tabij(i)
+     ENDDO
+
+       CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon_glo,zx_lon)
+       if ((iim*jjm).gt.1) then
+       DO i = 1, iim
+         zx_lon(i,1) = rlon_glo(i+1)
+         zx_lon(i,jjmp1) = rlon_glo(i+1)
+       ENDDO
+       endif
+       CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat_glo,zx_lat)
+
+    DO i=1,pim
+!    print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
+
+     plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i))
+     plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
+
+     if (ipt(i).EQ.1) then
+      plon_bounds(i,1)=zx_lon(iim,jpt(i))
+      plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
+     endif
+ 
+     if (ipt(i).EQ.iim) then
+      plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
+     endif
+
+     plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
+     plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
+
+     if (jpt(i).EQ.1) then
+      plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
+      plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
+     endif
+ 
+     if (jpt(i).EQ.jjmp1) then
+      plat_bounds(i,1)=zx_lat(ipt(i),jjmp1)+0.001
+      plat_bounds(i,2)=zx_lat(ipt(i),jjmp1)-0.001
+     endif
+!
+!    print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2) 
+!    print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2) 
+!
+    ENDDO
+!    print*,'iophy is_sequential nname, nnhori, nnid_day=',trim(nname),nnhori,nnid_day
+     call histbeg(nname,pim,plon,plon_bounds, & 
+                           plat,plat_bounds, &
+                           itau0, zjulian, dtime, nnhori, nnid_day)
+    else
+     npproc=0
+     DO ip=1, pim
+      tabprocbeg=klon_mpi_begin
+      tabprocend=klon_mpi_end
+      IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
+       npproc=npproc+1
+       npstn=npproc
+      ENDIF 
+     ENDDO
+!    print*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn
+     IF(.NOT. ALLOCATED(nptabij)) THEN
+      ALLOCATE(nptabij(npstn))
+      ALLOCATE(npplon(npstn), npplat(npstn))
+      ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2))
+     ENDIF
+     npproc=0
+     DO ip=1, pim
+      IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
+       npproc=npproc+1
+       nptabij(npproc)=tabij(ip)
+!      print*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, &
+!      plon(ip),plat(ip),tabij(ip)
+       npplon(npproc)=plon(ip)
+       npplat(npproc)=plat(ip)
+       npplon_bounds(npproc,1)=plon_bounds(ip,1)
+       npplon_bounds(npproc,2)=plon_bounds(ip,2)
+       npplat_bounds(npproc,1)=plat_bounds(ip,1)
+       npplat_bounds(npproc,2)=plat_bounds(ip,2)
+!!!
+!!! print qui sert a reordonner les points stations selon l'ordre CFMIP
+!!! ne pas enlever
+        print*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip)
+!!!
+      ENDIF
+     ENDDO
+     call histbeg(nname,npstn,npplon,npplon_bounds, &
+                            npplat,npplat_bounds, &
+                            itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
+    endif
+!$OMP END MASTER
+
+  end subroutine histbeg_phy_points
+ 
+  subroutine histwrite2d_phy(nid,lpoint,name,itau,field)
+  USE dimphy
+  USE mod_phys_lmdz_para
+  USE ioipsl
+  implicit none
+  include 'dimensions.h'
+    
+    integer,intent(in) :: nid
+    logical,intent(in) :: lpoint 
+    character*(*), intent(IN) :: name
+    integer, intent(in) :: itau
+    real,dimension(:),intent(in) :: field
+    REAL,dimension(klon_mpi) :: buffer_omp
+    INTEGER, allocatable, dimension(:) :: index2d
+    REAL :: Field2d(iim,jj_nb)
+
+    integer :: ip
+    real,allocatable,dimension(:) :: fieldok
+
+    IF (size(field)/=klon) CALL abort_gcm('iophy::histwrite2d','Field first dimension not equal to klon',1)
+    
+    CALL Gather_omp(field,buffer_omp)    
+!$OMP MASTER
+    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
+    if(.NOT.lpoint) THEN
+     ALLOCATE(index2d(iim*jj_nb))
+     ALLOCATE(fieldok(iim*jj_nb))
+     CALL histwrite(nid,name,itau,Field2d,iim*jj_nb,index2d)
+    else
+     ALLOCATE(fieldok(npstn))
+     ALLOCATE(index2d(npstn))
+
+     if(is_sequential) then
+!     klon_mpi_begin=1
+!     klon_mpi_end=klon
+      DO ip=1, npstn
+       fieldok(ip)=buffer_omp(nptabij(ip))
+      ENDDO
+     else
+      DO ip=1, npstn
+!     print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
+       IF(nptabij(ip).GE.klon_mpi_begin.AND. &
+          nptabij(ip).LE.klon_mpi_end) THEN
+         fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
+       ENDIF
+      ENDDO
+     endif
+     CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
+!
+    endif
+    deallocate(index2d)
+    deallocate(fieldok)
+!$OMP END MASTER    
+  end subroutine histwrite2d_phy
+
+  subroutine histwrite3d_phy(nid,lpoint,name,itau,field)
+  USE dimphy
+  USE mod_phys_lmdz_para
+
+  use ioipsl
+  implicit none
+  include 'dimensions.h'
+    
+    integer,intent(in) :: nid
+    logical,intent(in) :: lpoint
+    character*(*), intent(IN) :: name
+    integer, intent(in) :: itau
+    real,dimension(:,:),intent(in) :: field  ! --> field(klon,:)
+    REAL,dimension(klon_mpi,size(field,2)) :: buffer_omp
+    REAL :: Field3d(iim,jj_nb,size(field,2))
+    INTEGER :: ip, n, nlev
+    INTEGER, ALLOCATABLE, dimension(:) :: index3d
+    real,allocatable, dimension(:,:) :: fieldok
+
+    IF (size(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first dimension not equal to klon',1)
+    nlev=size(field,2)
+
+!   print*,'hist3d_phy mpi_rank npstn=',mpi_rank,npstn
+
+!   DO ip=1, npstn
+!    print*,'hist3d_phy mpi_rank nptabij',mpi_rank,nptabij(ip)
+!   ENDDO
+
+    CALL Gather_omp(field,buffer_omp)
+!$OMP MASTER
+    CALL grid1Dto2D_mpi(buffer_omp,field3d)
+    if(.NOT.lpoint) THEN
+     ALLOCATE(index3d(iim*jj_nb*nlev))
+     ALLOCATE(fieldok(iim*jj_nb,nlev))
+     CALL histwrite(nid,name,itau,Field3d,iim*jj_nb*nlev,index3d)
+    else
+      nlev=size(field,2)
+      ALLOCATE(index3d(npstn*nlev))
+      ALLOCATE(fieldok(npstn,nlev))
+
+      if(is_sequential) then
+!      klon_mpi_begin=1
+!      klon_mpi_end=klon
+       DO n=1, nlev
+       DO ip=1, npstn
+        fieldok(ip,n)=buffer_omp(nptabij(ip),n)
+       ENDDO
+       ENDDO
+      else
+       DO n=1, nlev
+       DO ip=1, npstn
+        IF(nptabij(ip).GE.klon_mpi_begin.AND. &
+         nptabij(ip).LE.klon_mpi_end) THEN
+         fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
+        ENDIF
+       ENDDO
+       ENDDO
+      endif
+      CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
+    endif 
+  deallocate(index3d)
+  deallocate(fieldok)
+!$OMP END MASTER    
+  end subroutine histwrite3d_phy
+  
+end module iophy
Index: trunk/LMDZ.TITAN/libf/phytitan/iostart.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/iostart.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/iostart.F90	(revision 1056)
@@ -0,0 +1,508 @@
+MODULE iostart
+
+PRIVATE
+    INTEGER,SAVE :: nid_start 
+    INTEGER,SAVE :: nid_restart
+    
+    INTEGER,SAVE :: idim1,idim2,idim3,idim4
+    INTEGER,PARAMETER :: length=100
+    
+    INTERFACE get_field
+      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
+    END INTERFACE get_field
+    
+    INTERFACE get_var
+      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
+    END INTERFACE get_var
+
+    INTERFACE put_field
+      MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
+    END INTERFACE put_field
+
+    INTERFACE put_var
+      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
+    END INTERFACE put_var
+
+    PUBLIC get_field,get_var,put_field,put_var
+    PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
+    
+CONTAINS
+
+  SUBROUTINE open_startphy(filename)
+  USE netcdf
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: filename
+    INTEGER          :: ierr
+
+    IF (is_mpi_root .AND. is_omp_root) THEN
+      ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start)
+      IF (ierr.NE.NF90_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//filename
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+    ENDIF
+   
+  END SUBROUTINE open_startphy
+
+  SUBROUTINE Close_startphy
+  USE netcdf
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    INTEGER          :: ierr
+
+    IF (is_mpi_root .AND. is_omp_root) THEN
+        ierr = NF90_CLOSE (nid_start)
+    ENDIF
+
+  END SUBROUTINE close_startphy
+
+
+  FUNCTION Inquire_Field(Field_name)
+  USE netcdf
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: Field_name
+    LOGICAL :: inquire_field
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
+      IF (ierr==NF90_NOERR) THEN
+        Inquire_field=.TRUE.
+      ELSE
+        Inquire_field=.FALSE.
+      ENDIF
+    ENDIF
+
+    CALL bcast(Inquire_field)
+
+  END FUNCTION Inquire_Field
+  
+ 
+  SUBROUTINE Get_Field_r1(field_name,field,found)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,1,found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,1)
+    ENDIF
+      
+  END SUBROUTINE Get_Field_r1
+  
+  SUBROUTINE Get_Field_r2(field_name,field,found)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:,:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,size(field,2),found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,size(field,2))
+    ENDIF
+
+      
+  END SUBROUTINE Get_Field_r2
+  
+  SUBROUTINE Get_Field_r3(field_name,field,found)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
+    REAL,INTENT(INOUT)               :: Field(:,:,:)
+    LOGICAL,INTENT(OUT),OPTIONAL   :: found 
+
+    IF (PRESENT(found)) THEN
+      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),found)
+    ELSE
+      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3))
+    ENDIF
+      
+  END SUBROUTINE Get_Field_r3
+  
+  SUBROUTINE Get_field_rgen(field_name,field,field_size,found)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: Field_name
+    INTEGER          :: field_size
+    REAL             :: field(klon,field_size)
+    LOGICAL,OPTIONAL :: found
+    
+    REAL    :: field_glo(klon_glo,field_size)
+    LOGICAL :: tmp_found
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+  
+      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
+      
+      IF (ierr==NF90_NOERR) THEN
+        CALL body(field_glo)
+        tmp_found=.TRUE.
+      ELSE
+        tmp_found=.FALSE.
+      ENDIF
+    
+    ENDIF
+    
+    CALL bcast(tmp_found)
+
+    IF (tmp_found) THEN
+      CALL scatter(field_glo,field)
+    ENDIF
+    
+    IF (PRESENT(found)) THEN
+      found=tmp_found
+    ELSE
+      IF (.NOT. tmp_found) THEN
+        PRINT*, 'phyetat0: Le champ <'//field_name//'> est absent'
+        CALL abort
+      ENDIF
+    ENDIF
+ 
+    
+    CONTAINS
+     
+     SUBROUTINE body(field_glo)
+       REAL :: field_glo(klon_glo*field_size)
+         ierr=NF90_GET_VAR(nid_start,varid,field_glo)
+         IF (ierr/=NF90_NOERR) THEN
+           ! La variable exist dans le fichier mais la lecture a echouee. 
+           PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>'
+
+           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
+              ! Essaye de lire le variable sur surface uniqument, comme fait avant
+              field_glo(:)=0.
+              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
+              IF (ierr/=NF90_NOERR) THEN
+                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
+                 CALL abort
+              ELSE
+                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
+              END IF
+           ELSE
+              CALL abort
+           ENDIF
+         ENDIF
+
+     END SUBROUTINE body
+
+  END SUBROUTINE Get_field_rgen
+  
+
+  SUBROUTINE get_var_r0(var_name,var,found)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+
+    REAL                         :: varout(1)
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,varout,size(varout),found)
+    ELSE
+      CALL Get_var_rgen(var_name,varout,size(varout))
+    ENDIF
+    var=varout(1)
+ 
+  END SUBROUTINE get_var_r0
+
+  SUBROUTINE get_var_r1(var_name,var,found)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var(:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r1
+
+  SUBROUTINE get_var_r2(var_name,var,found)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(OUT)             :: var(:,:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r2
+
+  SUBROUTINE get_var_r3(var_name,var,found)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN)  :: var_name
+    REAL,INTENT(INOUT)             :: var(:,:,:)
+    LOGICAL,OPTIONAL,INTENT(OUT) :: found
+    
+    IF (PRESENT(found)) THEN
+      CALL Get_var_rgen(var_name,var,size(var),found)
+    ELSE
+      CALL Get_var_rgen(var_name,var,size(var))
+    ENDIF
+  
+  END SUBROUTINE get_var_r3
+
+  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: var_name
+    INTEGER          :: var_size
+    REAL             :: var(var_size)
+    LOGICAL,OPTIONAL :: found
+    
+    LOGICAL :: tmp_found
+    INTEGER :: varid
+    INTEGER :: ierr
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+  
+      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
+      
+      IF (ierr==NF90_NOERR) THEN
+        ierr=NF90_GET_VAR(nid_start,varid,var)
+        IF (ierr/=NF90_NOERR) THEN
+          PRINT*, 'phyetat0: Lecture echouee pour <'//var_name//'>'
+          CALL abort
+        ENDIF
+        tmp_found=.TRUE.
+      ELSE
+        tmp_found=.FALSE.
+      ENDIF
+    
+    ENDIF
+    
+    CALL bcast(tmp_found)
+
+    IF (tmp_found) THEN
+      CALL bcast(var)
+    ENDIF
+    
+    IF (PRESENT(found)) THEN
+      found=tmp_found
+    ELSE
+      IF (.NOT. tmp_found) THEN
+        PRINT*, 'phyetat0: La variable champ <'//var_name//'> est absente'
+        CALL abort
+      ENDIF
+    ENDIF
+
+  END SUBROUTINE Get_var_rgen
+
+
+  SUBROUTINE open_restartphy(filename)
+  USE netcdf
+  USE mod_phys_lmdz_para
+  USE mod_grid_phy_lmdz
+  USE dimphy
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: filename
+    INTEGER                     :: ierr
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+      ierr = NF90_CREATE(filename, NF90_CLOBBER, nid_restart)
+      IF (ierr/=NF90_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier '//filename
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+
+      ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemarrage physique")
+
+      ierr = NF90_DEF_DIM (nid_restart, "index", length, idim1)
+      ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2)
+      ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3)
+      ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
+
+      ierr = NF90_ENDDEF(nid_restart)
+    ENDIF
+
+  END SUBROUTINE open_restartphy
+  
+  SUBROUTINE close_restartphy
+  USE netcdf
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+    INTEGER          :: ierr
+
+    IF (is_mpi_root .AND. is_omp_root) THEN
+      ierr = NF90_CLOSE (nid_restart)
+    ENDIF
+ 
+  END SUBROUTINE close_restartphy
+
+  
+  SUBROUTINE put_field_r1(field_name,title,field)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:)
+  
+    CALL put_field_rgen(field_name,title,field,1)
+  
+  END SUBROUTINE put_field_r1
+
+  SUBROUTINE put_field_r2(field_name,title,field)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:,:)
+  
+    CALL put_field_rgen(field_name,title,field,size(field,2))
+  
+  END SUBROUTINE put_field_r2
+
+  SUBROUTINE put_field_r3(field_name,title,field)
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  REAL,INTENT(IN)                :: field(:,:,:)
+  
+    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
+  
+  END SUBROUTINE put_field_r3
+  
+  SUBROUTINE put_field_rgen(field_name,title,field,field_size)
+  USE netcdf
+  USE dimphy
+  USE mod_grid_phy_lmdz
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(IN)    :: field_name
+  CHARACTER(LEN=*),INTENT(IN)    :: title
+  INTEGER,INTENT(IN)             :: field_size
+  REAL,INTENT(IN)                :: field(klon,field_size)
+  
+  REAL                           :: field_glo(klon_glo,field_size)
+  INTEGER                        :: ierr
+  INTEGER                        :: nvarid
+  INTEGER                        :: idim
+   
+   
+    CALL gather(field,field_glo)
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+
+      IF (field_size==1) THEN
+        idim=idim2
+      ELSE IF (field_size==klev) THEN
+        idim=idim3
+      ELSE IF (field_size==klevp1) THEN
+        idim=idim4
+      ELSE
+        PRINT *, "erreur phyredem : probleme de dimension"
+        CALL ABORT
+      ENDIF
+         
+      ierr = NF90_REDEF (nid_restart)
+#ifdef NC_DOUBLE
+      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
+#else
+      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
+#endif
+      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
+      ierr = NF90_ENDDEF(nid_restart)
+      ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
+    ENDIF
+    
+   END SUBROUTINE put_field_rgen  
+  
+   SUBROUTINE put_var_r0(var_name,title,var)
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var
+     REAL                        :: varin(1)
+     
+     varin(1)=var
+     
+     CALL put_var_rgen(var_name,title,varin,size(varin))
+
+  END SUBROUTINE put_var_r0
+
+
+   SUBROUTINE put_var_r1(var_name,title,var)
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r1
+ 
+  SUBROUTINE put_var_r2(var_name,title,var)
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:,:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r2     
+  
+  SUBROUTINE put_var_r3(var_name,title,var)
+   IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     REAL,INTENT(IN)             :: var(:,:,:)
+     
+     CALL put_var_rgen(var_name,title,var,size(var))
+
+  END SUBROUTINE put_var_r3
+
+  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
+  USE netcdf
+  USE dimphy
+  USE mod_phys_lmdz_para
+  IMPLICIT NONE
+     CHARACTER(LEN=*),INTENT(IN) :: var_name
+     CHARACTER(LEN=*),INTENT(IN) :: title
+     INTEGER,INTENT(IN)          :: var_size
+     REAL,INTENT(IN)             :: var(var_size)
+     
+     INTEGER :: ierr
+     INTEGER :: nvarid
+         
+    IF (is_mpi_root .AND. is_omp_root) THEN
+
+      IF (var_size/=length) THEN
+        PRINT *, "erreur phyredem : probleme de dimension"
+        CALL abort
+      ENDIF
+      
+      ierr = NF90_REDEF (nid_restart)
+
+#ifdef NC_DOUBLE
+      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
+#else
+      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
+#endif
+      IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
+      ierr = NF90_ENDDEF(nid_restart)
+     
+      ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
+
+    ENDIF
+    
+  END SUBROUTINE put_var_rgen     
+    
+END MODULE iostart
Index: trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_data.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_data.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_data.F90	(revision 1056)
@@ -0,0 +1,203 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_data
+  USE mod_const_mpi
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+  INTEGER,SAVE :: klon_mpi_begin
+  INTEGER,SAVE :: klon_mpi_end
+  INTEGER,SAVE :: klon_mpi
+  
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end
+
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: klon_mpi_para_end 
+
+  
+  INTEGER,SAVE :: mpi_rank
+  INTEGER,SAVE :: mpi_size
+  INTEGER,SAVE :: mpi_root
+  LOGICAL,SAVE :: is_mpi_root
+  LOGICAL,SAVE :: is_using_mpi
+  
+  
+  LOGICAL,SAVE :: is_north_pole
+  LOGICAL,SAVE :: is_south_pole
+  INTEGER,SAVE :: COMM_LMDZ_PHY
+
+CONTAINS
+  
+  SUBROUTINE init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+  USE mod_const_mpi, ONLY : COMM_LMDZ
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+    
+    INTEGER :: ierr
+    INTEGER :: klon_glo
+    INTEGER :: i
+    
+#ifdef CPP_MPI
+    is_using_mpi=.TRUE.
+#else
+    is_using_mpi=.FALSE.
+#endif
+    
+    if (iim.eq.1) then
+       klon_glo=1
+    else
+       klon_glo=iim*(jjp1-2)+2
+    endif
+    
+    COMM_LMDZ_PHY=COMM_LMDZ
+
+    IF (is_using_mpi) THEN    
+#ifdef CPP_MPI
+      CALL MPI_COMM_SIZE(COMM_LMDZ_PHY,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(COMM_LMDZ_PHY,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN
+      mpi_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    IF (mpi_rank == 0) THEN 
+      is_north_pole = .TRUE.
+    ELSE
+      is_north_pole = .FALSE.
+    ENDIF
+    
+    IF (mpi_rank == mpi_size-1) THEN
+      is_south_pole = .TRUE.
+    ELSE
+      is_south_pole = .FALSE.
+    ENDIF
+    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))
+
+    ALLOCATE(klon_mpi_para_nb(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(klon_mpi_para_end(0:mpi_size-1))
+  
+      
+    klon_mpi_para_nb(0:mpi_size-1)=distrib(0:nb_proc-1)
+
+    DO i=0,mpi_size-1
+      IF (i==0) THEN 
+        klon_mpi_para_begin(i)=1
+      ELSE 
+        klon_mpi_para_begin(i)=klon_mpi_para_end(i-1)+1
+      ENDIF
+        klon_mpi_para_end(i)=klon_mpi_para_begin(i)+klon_mpi_para_nb(i)-1
+    ENDDO
+
+
+    DO i=0,mpi_size-1
+      
+      IF (i==0) THEN
+        ij_para_begin(i) = 1
+      ELSE
+        ij_para_begin(i) = klon_mpi_para_begin(i)+iim-1
+      ENDIF
+
+      jj_para_begin(i) = (ij_para_begin(i)-1)/iim + 1
+      ii_para_begin(i) = MOD(ij_para_begin(i)-1,iim) + 1
+
+      
+      ij_para_end(i) = klon_mpi_para_end(i)+iim-1
+      jj_para_end(i) = (ij_para_end(i)-1)/iim + 1
+      ii_para_end(i) = MOD(ij_para_end(i)-1,iim) + 1
+
+
+      ij_para_nb(i) = ij_para_end(i)-ij_para_begin(i)+1
+      jj_para_nb(i) = jj_para_end(i)-jj_para_begin(i)+1
+         
+    ENDDO
+  
+    ii_begin = ii_para_begin(mpi_rank)
+    ii_end   = ii_para_end(mpi_rank)
+    jj_begin = jj_para_begin(mpi_rank)
+    jj_end   = jj_para_end(mpi_rank)
+    jj_nb    = jj_para_nb(mpi_rank)
+    ij_begin = ij_para_begin(mpi_rank)
+    ij_end   = ij_para_end(mpi_rank)
+    ij_nb    = ij_para_nb(mpi_rank)
+    klon_mpi_begin = klon_mpi_para_begin(mpi_rank)
+    klon_mpi_end   = klon_mpi_para_end(mpi_rank)
+    klon_mpi       = klon_mpi_para_nb(mpi_rank)
+   
+    CALL print_module_data
+    
+  END SUBROUTINE init_phys_lmdz_mpi_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+  INCLUDE "iniprint.h" 
+  
+    WRITE(lunout,*) 'ii_begin =', ii_begin
+    WRITE(lunout,*) 'ii_end =', ii_end
+    WRITE(lunout,*) 'jj_begin =',jj_begin
+    WRITE(lunout,*) 'jj_end =', jj_end
+    WRITE(lunout,*) 'jj_nb =', jj_nb
+    WRITE(lunout,*) 'ij_begin =', ij_begin
+    WRITE(lunout,*) 'ij_end =', ij_end
+    WRITE(lunout,*) 'ij_nb =', ij_nb
+    WRITE(lunout,*) 'klon_mpi_begin =', klon_mpi_begin
+    WRITE(lunout,*) 'klon_mpi_end =', klon_mpi_end
+    WRITE(lunout,*) 'klon_mpi =', klon_mpi
+    WRITE(lunout,*) 'jj_para_nb =', jj_para_nb
+    WRITE(lunout,*) 'jj_para_begin =', jj_para_begin
+    WRITE(lunout,*) 'jj_para_end =', jj_para_end
+    WRITE(lunout,*) 'ii_para_begin =', ii_para_begin
+    WRITE(lunout,*) 'ii_para_end =', ii_para_end
+    WRITE(lunout,*) 'ij_para_nb =', ij_para_nb
+    WRITE(lunout,*) 'ij_para_begin =', ij_para_begin
+    WRITE(lunout,*) 'ij_para_end =', ij_para_end
+    WRITE(lunout,*) 'klon_mpi_para_nb =', klon_mpi_para_nb
+    WRITE(lunout,*) 'klon_mpi_para_begin =', klon_mpi_para_begin
+    WRITE(lunout,*) 'klon_mpi_para_end  =', klon_mpi_para_end 
+    WRITE(lunout,*) 'mpi_rank =', mpi_rank
+    WRITE(lunout,*) 'mpi_size =', mpi_size
+    WRITE(lunout,*) 'mpi_root =', mpi_root
+    WRITE(lunout,*) 'is_mpi_root =', is_mpi_root
+    WRITE(lunout,*) 'is_north_pole =', is_north_pole
+    WRITE(lunout,*) 'is_south_pole =', is_south_pole
+    WRITE(lunout,*) 'COMM_LMDZ_PHY =', COMM_LMDZ_PHY
+  
+  END SUBROUTINE print_module_data
+  
+END MODULE mod_phys_lmdz_mpi_data
Index: trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_transfert.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_transfert.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_mpi_transfert.F90	(revision 1056)
@@ -0,0 +1,1902 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_mpi_transfert
+
+
+  INTERFACE bcast_mpi
+    MODULE PROCEDURE bcast_mpi_c,                                                     &
+                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+		     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+		     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_mpi
+    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+		     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D_mpi
+    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+		     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+		     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum_mpi
+    MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+                     reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE 
+
+ INTERFACE grid1dTo2d_mpi
+    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
+                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
+		     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
+ END INTERFACE 
+
+ INTERFACE grid2dTo1d_mpi
+    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
+                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
+		     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
+ END INTERFACE 
+    
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+    CALL bcast_mpi_cgen(Var1,len(Var1))
+
+  END SUBROUTINE bcast_mpi_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_mpi_i(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    INTEGER               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_igen(Var_tmp,1)
+    var=var_tmp(1)
+    
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    CALL bcast_mpi_igen(Var,size(Var))
+    
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+  
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_igen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_rgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_rgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+  USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL               :: var_tmp(1)
+    
+    IF (is_mpi_root) var_tmp(1)=var
+    CALL bcast_mpi_lgen(Var_tmp,1)
+    var=var_tmp(1)   
+
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL bcast_mpi_lgen(Var,size(Var))
+
+  END SUBROUTINE bcast_mpi_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL scatter_mpi_igen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2))
+    
+  END SUBROUTINE scatter_mpi_i1
+  
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL scatter_mpi_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,1)
+  
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_r1
+  
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,1)
+    
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2))
+  
+  END SUBROUTINE scatter_mpi_l1
+  
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+  
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL scatter_mpi_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+  
+  END SUBROUTINE scatter_mpi_l3  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_i
+  
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+      CALL gather_mpi_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2))
+  
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+  
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+      CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+  
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL gather_mpi_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+  
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_i2
+  
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    INTEGER,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_R
+
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r1
+
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_r2
+  
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_r3
+  
+  
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp    
+    
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l
+
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE scatter2D_mpi_l1
+
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3)) :: Var_tmp
+  
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_mpi_l2
+  
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,2),size(VarOut,3),size(VarOut,4)) :: Var_tmp
+
+    CALL grid2dTo1d_glo(VarIn,Var_tmp)
+    CALL scatter_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE scatter2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i2
+  
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+ 
+    INTEGER,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_i3
+
+
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r2
+  
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_r3
+
+  
+  
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4)) :: Var_tmp
+
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l2
+  
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_glo,size(VarOut,3),SIZE(VarOut,4),SIZE(VarOut,5)) :: Var_tmp
+    
+    CALL gather_mpi(VarIn,Var_tmp)
+    CALL grid1dTo2d_glo(Var_tmp,VarOut)
+
+  END SUBROUTINE gather2D_mpi_l3
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_igen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_i4                  
+  
+  
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn    
+    CALL reduce_sum_mpi_rgen(VarIn_tmp,Varout_tmp,1)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+     
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+  
+  END SUBROUTINE reduce_sum_mpi_r4 
+  
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! SUBROUTINE grid1dTo2d  !!  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  SUBROUTINE grid1dTo2d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_i
+  
+
+  SUBROUTINE grid1dTo2d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i1
+
+  SUBROUTINE grid1dTo2d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i2
+  
+  SUBROUTINE grid1dTo2d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_igen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_i3
+
+
+  SUBROUTINE grid1dTo2d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_r
+  
+
+  SUBROUTINE grid1dTo2d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r1
+
+  SUBROUTINE grid1dTo2d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r2
+  
+  SUBROUTINE grid1dTo2d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_rgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_r3
+  
+  
+  
+  SUBROUTINE grid1dTo2d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid1dTo2d_mpi_l
+  
+
+  SUBROUTINE grid1dTo2d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l1
+
+  SUBROUTINE grid1dTo2d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l2
+  
+  SUBROUTINE grid1dTo2d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:)     :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:)  :: VarOut
+    
+    CALL grid1dTo2d_mpi_lgen(VarIn,VarOut,size(VarIn,2)*size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid1dTo2d_mpi_l3
+
+
+  SUBROUTINE grid2dTo1d_mpi_i(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_i
+  
+
+  SUBROUTINE grid2dTo1d_mpi_i1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i1
+
+  SUBROUTINE grid2dTo1d_mpi_i2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i2
+  
+  SUBROUTINE grid2dTo1d_mpi_i3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_igen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_i3
+ 
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_r(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_r
+  
+
+  SUBROUTINE grid2dTo1d_mpi_r1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r1
+
+  SUBROUTINE grid2dTo1d_mpi_r2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r2
+  
+  SUBROUTINE grid2dTo1d_mpi_r3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_rgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_r3
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,1)
+  
+  END SUBROUTINE grid2dTo1d_mpi_l
+  
+
+  SUBROUTINE grid2dTo1d_mpi_l1(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l1
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_l2(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l2
+
+  
+  SUBROUTINE grid2dTo1d_mpi_l3(VarIn,VarOut)  
+  IMPLICIT NONE  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:)  :: VarOut
+    
+    CALL grid2dTo1d_mpi_lgen(VarIn,VarOut,size(VarIn,3)*size(VarIn,4)*size(VarIn,5))
+  
+  END SUBROUTINE grid2dTo1d_mpi_l3
+
+               
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_mpi_cgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+    
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_cgen
+
+
+      
+  SUBROUTINE bcast_mpi_igen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_INTEGER,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE bcast_mpi_igen
+
+
+
+  
+  SUBROUTINE bcast_mpi_rgen(var,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_REAL_LMDZ,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+    
+  END SUBROUTINE bcast_mpi_rgen
+  
+
+
+
+  SUBROUTINE bcast_mpi_lgen(var,nb)
+    USE mod_phys_lmdz_mpi_data ,  mpi_root_x=>mpi_root
+    IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) RETURN
+
+#ifdef CPP_MPI
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE bcast_mpi_lgen
+
+  
+
+  SUBROUTINE scatter_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INTEGER,VarOut,klon_mpi*dimsize,   &
+                      MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_igen
+
+  SUBROUTINE scatter_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI 
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_LMDZ,VarOut,klon_mpi*dimsize,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+
+#endif
+
+  END SUBROUTINE scatter_mpi_rgen
+
+  
+  SUBROUTINE scatter_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_glo,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+    
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index:Index+nb-1)=VarIn(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)
+          Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+      
+#ifdef CPP_MPI
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,klon_mpi*dimsize,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+  END SUBROUTINE scatter_mpi_lgen  
+
+
+
+
+  SUBROUTINE gather_mpi_igen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+     
+    ENDIF
+    
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_INTEGER,VarTmp,counts,displs,   &
+                     MPI_INTEGER,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_igen  
+
+  SUBROUTINE gather_mpi_rgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_REAL_LMDZ,VarTmp,counts,displs,   &
+                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_rgen  
+
+  SUBROUTINE gather_mpi_lgen(VarIn, VarOut, dimsize)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_glo,dimsize) :: VarOut
+  
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*klon_glo) :: VarTmp
+    INTEGER :: nb,i,index,rank
+    INTEGER :: ierr
+    
+    IF (.not.is_using_mpi) THEN
+      VarOut(:,:)=VarIn(:,:)
+      RETURN
+    ENDIF
+
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        displs(rank)=Index-1
+        counts(rank)=nb*dimsize
+	Index=Index+nb*dimsize
+      ENDDO
+    ENDIF
+    
+
+#ifdef CPP_MPI
+    CALL MPI_GATHERV(VarIn,klon_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
+#endif
+		          
+    IF (is_mpi_root) THEN
+      Index=1
+      DO rank=0,mpi_size-1
+        nb=klon_mpi_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
+	  Index=Index+nb
+        ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE gather_mpi_lgen
+  
+
+
+  SUBROUTINE reduce_sum_mpi_igen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+   
+    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
+    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+   
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+
+
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INTEGER,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+            
+  END SUBROUTINE reduce_sum_mpi_igen
+  
+  SUBROUTINE reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+    USE mod_phys_lmdz_mpi_data , mpi_root_x=>mpi_root
+    USE mod_grid_phy_lmdz
+
+    IMPLICIT NONE
+
+#ifdef CPP_MPI
+    INCLUDE 'mpif.h'
+#endif
+    
+    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
+    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    INTEGER :: ierr
+ 
+    IF (.not.is_using_mpi) THEN
+      VarOut(:)=VarIn(:)
+      RETURN
+    ENDIF
+   
+#ifdef CPP_MPI
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_LMDZ,MPI_SUM,mpi_root_x,COMM_LMDZ_PHY,ierr)
+#endif
+        
+  END SUBROUTINE reduce_sum_mpi_rgen
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE grid1dTo2d_mpi_igen   
+
+
+  SUBROUTINE grid1dTo2d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=0
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=0
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_rgen   
+
+
+
+  SUBROUTINE grid1dTo2d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(klon_mpi,dimsize)       :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_lon*jj_nb,dimsize)  :: VarOut
+    INTEGER :: i,ij,Offset
+
+    
+    VarOut(1:nbp_lon,:)=.FALSE.
+    VarOut(nbp_lon*(jj_nb-1)+1:nbp_lon*jj_nb,:)=.FALSE.
+    
+    offset=ii_begin
+    IF (is_north_pole) Offset=nbp_lon
+    
+    
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij+offset-1,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+    
+    
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        DO ij=1,nbp_lon
+         VarOut(ij,i)=VarIn(1,i)
+	ENDDO
+      ENDDO
+    ENDIF
+    
+    IF (is_south_pole) THEN 
+      DO i=1,dimsize
+        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
+         VarOut(ij,i)=VarIn(klon_mpi,i)
+	ENDDO
+      ENDDO
+    ENDIF
+
+   END SUBROUTINE grid1dTo2d_mpi_lgen   
+
+  
+
+
+  SUBROUTINE grid2dTo1d_mpi_igen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_igen   
+
+
+
+  SUBROUTINE grid2dTo1d_mpi_rgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+         VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_rgen   
+  
+
+  SUBROUTINE grid2dTo1d_mpi_lgen(VarIn,VarOut,dimsize)
+    USE mod_phys_lmdz_mpi_data
+    USE mod_grid_phy_lmdz
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN) ,DIMENSION(nbp_lon*jj_nb,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize)      :: VarOut
+    INTEGER :: i,ij,offset
+
+    offset=ii_begin
+    IF (is_north_pole) offset=nbp_lon
+
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=VarIn(ij+offset-1,i)
+      ENDDO
+    ENDDO
+
+    IF (is_north_pole) THEN 
+      DO i=1,dimsize
+        VarOut(1,i)=VarIn(1,i)
+      ENDDO
+    ENDIF
+    
+    
+  END SUBROUTINE grid2dTo1d_mpi_lgen   
+
+END MODULE mod_phys_lmdz_mpi_transfert
Index: trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_data.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_data.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_data.F90	(revision 1056)
@@ -0,0 +1,109 @@
+!
+!$Id: mod_phys_lmdz_omp_data.F90 1575 2011-09-21 13:57:48Z jghattas $
+!
+MODULE mod_phys_lmdz_omp_data
+
+  INTEGER,SAVE :: omp_size
+  INTEGER,SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_using_omp
+  
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_nb
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_begin
+  INTEGER,SAVE,DIMENSION(:),ALLOCATABLE :: klon_omp_para_end    
+  
+  INTEGER,SAVE :: klon_omp
+  INTEGER,SAVE :: klon_omp_begin
+  INTEGER,SAVE :: klon_omp_end
+!$OMP  THREADPRIVATE(omp_rank,klon_omp,is_omp_root,klon_omp_begin,klon_omp_end)
+
+CONTAINS
+  
+  SUBROUTINE init_phys_lmdz_omp_data(klon_mpi)
+    USE dimphy
+    IMPLICIT NONE
+    INTEGER, INTENT(in) :: klon_mpi
+
+    INTEGER :: i
+
+    CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data'
+    CHARACTER (LEN=80) :: abort_message
+
+
+#ifdef CPP_OMP    
+    INTEGER :: OMP_GET_NUM_THREADS
+    EXTERNAL OMP_GET_NUM_THREADS
+    INTEGER :: OMP_GET_THREAD_NUM
+    EXTERNAL OMP_GET_THREAD_NUM
+#endif  
+
+#ifdef CPP_OMP
+!$OMP MASTER
+        is_using_omp=.TRUE.
+        omp_size=OMP_GET_NUM_THREADS()
+!$OMP END MASTER
+        omp_rank=OMP_GET_THREAD_NUM()    
+#else    
+    is_using_omp=.FALSE.
+    omp_size=1
+    omp_rank=0
+#endif
+
+   is_omp_root=.FALSE.
+!$OMP MASTER
+   IF (omp_rank==0) THEN
+     is_omp_root=.TRUE.
+   ELSE
+     abort_message = 'ANORMAL : OMP_MASTER /= 0'
+     CALL abort_gcm (modname,abort_message,1)
+   ENDIF
+!$OMP END MASTER
+
+
+!$OMP MASTER 
+    ALLOCATE(klon_omp_para_nb(0:omp_size-1))
+    ALLOCATE(klon_omp_para_begin(0:omp_size-1))
+    ALLOCATE(klon_omp_para_end(0:omp_size-1))
+    
+    DO i=0,omp_size-1
+      klon_omp_para_nb(i)=klon_mpi/omp_size
+      IF (i<MOD(klon_mpi,omp_size)) klon_omp_para_nb(i)=klon_omp_para_nb(i)+1
+    ENDDO
+    
+    klon_omp_para_begin(0) = 1
+    klon_omp_para_end(0) = klon_omp_para_nb(0)
+    
+    DO i=1,omp_size-1
+      klon_omp_para_begin(i)=klon_omp_para_end(i-1)+1
+      klon_omp_para_end(i)=klon_omp_para_begin(i)+klon_omp_para_nb(i)-1
+    ENDDO
+!$OMP END MASTER
+!$OMP BARRIER
+   
+    klon_omp=klon_omp_para_nb(omp_rank)
+    klon_omp_begin=klon_omp_para_begin(omp_rank)
+    klon_omp_end=klon_omp_para_end(omp_rank)
+    
+    CALL print_module_data
+    
+  END SUBROUTINE init_phys_lmdz_omp_data
+
+  SUBROUTINE print_module_data
+  IMPLICIT NONE
+  INCLUDE "iniprint.h"
+
+!$OMP CRITICAL  
+  WRITE(lunout,*)'--------> TASK ',omp_rank
+  WRITE(lunout,*)'omp_size =',omp_size
+  WRITE(lunout,*)'omp_rank =',omp_rank
+  WRITE(lunout,*)'is_omp_root =',is_omp_root
+  WRITE(lunout,*)'klon_omp_para_nb =',klon_omp_para_nb
+  WRITE(lunout,*)'klon_omp_para_begin =',klon_omp_para_begin
+  WRITE(lunout,*)'klon_omp_para_end =',klon_omp_para_end    
+  WRITE(lunout,*)'klon_omp =',klon_omp
+  WRITE(lunout,*)'klon_omp_begin =',klon_omp_begin
+  WRITE(lunout,*)'klon_omp_end =',klon_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE print_module_data
+END MODULE mod_phys_lmdz_omp_data
Index: trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_transfert.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_transfert.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_omp_transfert.F90	(revision 1056)
@@ -0,0 +1,1057 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_omp_transfert
+
+  PRIVATE
+  
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  
+  CHARACTER(LEN=size_min),SAVE            :: buffer_c
+!  INTEGER,SAVE                            :: size_c=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_i
+  INTEGER,SAVE                            :: size_i=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:)      :: buffer_r
+  INTEGER,SAVE                            :: size_r=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:)   :: buffer_l
+  INTEGER,SAVE                            :: size_l=0
+
+
+  
+  
+  INTERFACE bcast_omp
+    MODULE PROCEDURE bcast_omp_c,                                                     &
+                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+		     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+		     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+  
+  INTERFACE gather_omp
+    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+		     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+  
+  
+  INTERFACE reduce_sum_omp
+    MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+                     reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE 
+
+
+  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_i(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_i) THEN
+      IF (ALLOCATED(buffer_i)) DEALLOCATE(buffer_i)
+      size_i=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_i(size_i))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_r) THEN
+      IF (ALLOCATED(buffer_r)) DEALLOCATE(buffer_r)
+      size_r=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_r(size_r))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+  IMPLICIT NONE
+  INTEGER :: buff_size
+
+!$OMP BARRIER
+!$OMP MASTER
+    IF (buff_size>size_l) THEN
+      IF (ALLOCATED(buffer_l)) DEALLOCATE(buffer_l)
+      size_l=MAX(size_min,INT(grow_factor*buff_size))
+      ALLOCATE(buffer_l(size_l))
+    ENDIF
+!$OMP END MASTER
+!$OMP BARRIER
+  
+  END SUBROUTINE check_buffer_l
+    
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    
+    CALL bcast_omp_cgen(Var,len(Var),buffer_c)
+    
+  END SUBROUTINE bcast_omp_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_omp_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    INTEGER :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_i(1)
+    CALL bcast_omp_igen(Var_tmp,1,buffer_i)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_i
+
+
+  SUBROUTINE bcast_omp_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i1
+
+
+  SUBROUTINE bcast_omp_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i2
+
+
+  SUBROUTINE bcast_omp_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i3
+
+
+  SUBROUTINE bcast_omp_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_i(size(Var))
+    CALL bcast_omp_igen(Var,size(Var),buffer_i)
+
+  END SUBROUTINE bcast_omp_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+    REAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_r(1)
+    CALL bcast_omp_rgen(Var_tmp,1,buffer_r)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_r
+
+
+  SUBROUTINE bcast_omp_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r1
+
+
+  SUBROUTINE bcast_omp_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r2
+
+
+  SUBROUTINE bcast_omp_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r3
+
+
+  SUBROUTINE bcast_omp_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_r(size(Var))
+    CALL bcast_omp_rgen(Var,size(Var),buffer_r)
+
+  END SUBROUTINE bcast_omp_r4
+
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL :: Var_tmp(1)
+    
+    Var_tmp(1)=Var
+    CALL check_buffer_l(1)
+    CALL bcast_omp_lgen(Var_tmp,1,buffer_l)
+    Var=Var_tmp(1)
+
+  END SUBROUTINE bcast_omp_l
+
+
+  SUBROUTINE bcast_omp_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l1
+
+
+  SUBROUTINE bcast_omp_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l2
+
+
+  SUBROUTINE bcast_omp_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l3
+
+
+  SUBROUTINE bcast_omp_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    CALL check_buffer_l(size(Var))
+    CALL bcast_omp_lgen(Var,size(Var),buffer_l)
+
+  END SUBROUTINE bcast_omp_l4
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE scatter_omp_i
+
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2),buffer_i)
+    
+  END SUBROUTINE scatter_omp_i1
+  
+  
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_i)
+
+  END SUBROUTINE scatter_omp_i2
+
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL scatter_omp_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_i)
+  
+  END SUBROUTINE scatter_omp_i3
+
+
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE scatter_omp_r
+
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2),buffer_r)
+        
+  END SUBROUTINE scatter_omp_r1
+  
+  
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_r)
+
+  END SUBROUTINE scatter_omp_r2
+
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL scatter_omp_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_r)
+  
+  END SUBROUTINE scatter_omp_r3
+  
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE scatter_omp_l
+
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2),buffer_l)
+    
+  END SUBROUTINE scatter_omp_l1
+  
+  
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3),buffer_l)
+
+  END SUBROUTINE scatter_omp_l2
+
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarIn))   
+    CALL scatter_omp_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4),buffer_l)
+  
+  END SUBROUTINE scatter_omp_l3  
+  
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,1,buffer_i)
+    
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2),buffer_i)
+    
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_i)
+          
+  END SUBROUTINE gather_omp_i2
+  
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarOut))   
+    CALL gather_omp_igen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_i)
+    
+  END SUBROUTINE gather_omp_i3
+
+
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
+    
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
+        
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarOut))   
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
+    
+  END SUBROUTINE gather_omp_r2
+  
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    CALL Check_buffer_r(size(VarOut))       
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
+    
+  END SUBROUTINE gather_omp_r3
+
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,1,buffer_l)
+    
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2),buffer_l)
+    
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_l)
+    
+  END SUBROUTINE gather_omp_l2
+  
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    CALL Check_buffer_l(size(VarOut))   
+    CALL gather_omp_lgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_l)
+    
+  END SUBROUTINE gather_omp_l3
+
+
+
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    INTEGER             :: VarIn_tmp(1)
+    INTEGER             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_i(1)   
+    CALL reduce_sum_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
+    VarOut=VarOut_tmp(1)
+    
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+   
+  END SUBROUTINE reduce_sum_omp_i1
+  
+  
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i2
+
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i3
+
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_i(size(VarIn))   
+    CALL reduce_sum_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
+  
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    REAL             :: VarIn_tmp(1)
+    REAL             :: VarOut_tmp(1)
+    
+    VarIn_tmp(1)=VarIn
+    CALL Check_buffer_r(1)   
+    CALL reduce_sum_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
+    VarOut=VarOut_tmp(1)
+  
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+   
+  END SUBROUTINE reduce_sum_omp_r1
+  
+  
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r2
+
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r3
+
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+  
+    CALL Check_buffer_r(size(VarIn))   
+    CALL reduce_sum_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
+  
+  END SUBROUTINE reduce_sum_omp_r4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    LES ROUTINES GENERIQUES    !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE bcast_omp_cgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=*),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+    
+    INTEGER :: i
+  
+  !$OMP MASTER
+      Buff=Var
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var=Buff
+    ENDDO
+  !$OMP BARRIER      
+  
+  END SUBROUTINE bcast_omp_cgen
+
+
+      
+  SUBROUTINE bcast_omp_igen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+    INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_igen
+
+
+  SUBROUTINE bcast_omp_rgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_rgen
+
+  SUBROUTINE bcast_omp_lgen(Var,Nb,Buff)
+  IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+    INTEGER,INTENT(IN) :: Nb
+  
+    INTEGER :: i
+    
+  !$OMP MASTER
+    DO i=1,Nb
+      Buff(i)=Var(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,Nb
+      Var(i)=Buff(i)
+    ENDDO
+  !$OMP BARRIER        
+
+  END SUBROUTINE bcast_omp_lgen
+
+
+  SUBROUTINE scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+    USE mod_phys_lmdz_omp_data
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+ 
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+ 
+  END SUBROUTINE scatter_omp_igen
+
+
+  SUBROUTINE scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_rgen
+
+
+  SUBROUTINE scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_mpi,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_omp,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+ !$OMP MASTER 
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        Buff(ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        VarOut(ij,i)=Buff(klon_omp_begin-1+ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+  END SUBROUTINE scatter_omp_lgen
+
+
+
+
+
+  SUBROUTINE gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_igen
+
+
+  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_rgen
+
+
+  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+
+    INTEGER :: i,ij
+    
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO
+  !$OMP BARRIER  
+
+
+  !$OMP MASTER
+    DO i=1,dimsize
+      DO ij=1,klon_mpi
+        VarOut(ij,i)=Buff(ij,i)
+      ENDDO
+    ENDDO  
+  !$OMP END MASTER
+  !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_lgen
+
+
+  SUBROUTINE reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_igen
+
+  SUBROUTINE reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+    INTEGER :: i
+
+  !$OMP MASTER
+    Buff(:)=0
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  !$OMP CRITICAL     
+    DO i=1,dimsize
+      Buff(i)=Buff(i)+VarIn(i)
+    ENDDO
+  !$OMP END CRITICAL
+  !$OMP BARRIER  
+  
+  !$OMP MASTER
+    DO i=1,dimsize
+      VarOut(i)=Buff(i)
+    ENDDO
+  !$OMP END MASTER
+  !$OMP BARRIER
+  
+  END SUBROUTINE reduce_sum_omp_rgen
+
+END MODULE mod_phys_lmdz_omp_transfert
Index: trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_para.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_para.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_para.F90	(revision 1056)
@@ -0,0 +1,113 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_para
+  USE mod_phys_lmdz_transfert_para
+  USE mod_phys_lmdz_mpi_data
+  USE mod_phys_lmdz_omp_data
+    
+  INTEGER,SAVE :: klon_loc
+  LOGICAL,SAVE :: is_sequential
+  LOGICAL,SAVE :: is_parallel
+  LOGICAL,SAVE :: is_master
+  
+!$OMP THREADPRIVATE(klon_loc,is_master)
+  
+CONTAINS
+
+  SUBROUTINE init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: iim
+    INTEGER,INTENT(in) :: jjp1
+    INTEGER,INTENT(in) :: nb_proc
+    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
+
+    CALL init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)
+!$OMP PARALLEL
+    CALL init_phys_lmdz_omp_data(klon_mpi)
+    klon_loc=klon_omp
+    IF (is_mpi_root .AND. is_omp_root) THEN 
+       is_master=.TRUE.
+     ELSE
+       is_master=.FALSE.
+     ENDIF
+    CALL test_transfert
+!$OMP END PARALLEL    
+     IF (is_using_mpi .OR. is_using_omp) THEN
+       is_sequential=.FALSE.
+       is_parallel=.TRUE.
+     ELSE
+       is_sequential=.TRUE.
+       is_parallel=.FALSE.
+     ENDIF
+      
+  END SUBROUTINE init_phys_lmdz_para
+
+  SUBROUTINE test_transfert
+  USE mod_grid_phy_lmdz
+  IMPLICIT NONE
+    INCLUDE "iniprint.h"
+ 
+    REAL :: Test_Field1d_glo(klon_glo,nbp_lev)
+    REAL :: tmp1d_glo(klon_glo,nbp_lev)
+    REAL :: Test_Field2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: tmp2d_glo(nbp_lon,nbp_lat,nbp_lev)
+    REAL :: Test_Field1d_loc(klon_loc,nbp_lev)
+    REAL :: Test_Field2d_loc(nbp_lon,jj_nb,nbp_lev)
+    REAL :: CheckSum
+    
+    INTEGER :: i,l
+  
+    Test_Field1d_glo = 0.
+    Test_Field2d_glo = 0.
+    Test_Field1d_loc = 0.
+    Test_Field2d_loc = 0.
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER
+      DO l=1,nbp_lev
+        DO i=1,klon_glo
+!          Test_Field1d_glo(i,l)=MOD(i,10)+10*(l-1)
+           Test_Field1d_glo(i,l)=1
+        ENDDO
+      ENDDO
+!$OMP END MASTER  
+    ENDIF
+  
+    CALL Scatter(Test_Field1d_glo,Test_Field1d_loc)
+    CALL Gather(Test_Field1d_loc,tmp1d_glo)
+  
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+    CALL grid1dTo2d_glo(Test_Field1d_glo,Test_Field2d_glo)
+    CALL scatter2D(Test_Field2d_glo,Test_Field1d_loc)
+    CALL gather2d(Test_Field1d_loc,Test_Field2d_glo)
+    CALL grid2dTo1d_glo(Test_Field2d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo-tmp1d_glo)
+      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+
+    CALL bcast(Test_Field1d_glo)
+    CALL reduce_sum(Test_Field1d_glo,tmp1d_glo)
+
+    IF (is_mpi_root) THEN
+!$OMP MASTER  
+      Checksum=sum(Test_Field1d_glo*omp_size*mpi_size-tmp1d_glo)
+      WRITE(lunout,*) "------> Checksum =",Checksum," MUST BE 0"
+!$OMP END MASTER
+    ENDIF
+    
+     
+   END SUBROUTINE test_transfert
+  
+END MODULE mod_phys_lmdz_para
+    
Index: trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_transfert_para.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_transfert_para.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/mod_phys_lmdz_transfert_para.F90	(revision 1056)
@@ -0,0 +1,1275 @@
+!
+!$Header$
+!
+MODULE mod_phys_lmdz_transfert_para
+
+  USE mod_phys_lmdz_mpi_transfert
+  USE mod_phys_lmdz_omp_transfert 
+
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+  INTERFACE scatter2D
+    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
+                     scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
+		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
+  END INTERFACE
+
+  INTERFACE gather2D
+    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
+                     gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
+		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_l3
+  END INTERFACE 
+  
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+!$OMP MASTER
+    CALL bcast_mpi(Var)
+!$OMP END MASTER
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+    
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+!$OMP MASTER
+      CALL scatter_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+      CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,Varout)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!! --> Les entiers
+
+  SUBROUTINE scatter2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i
+
+
+  SUBROUTINE scatter2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i1
+  
+
+  SUBROUTINE scatter2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i2  
+
+
+  SUBROUTINE scatter2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_i3
+  
+
+!!!!! --> Les reels
+
+  SUBROUTINE scatter2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r
+
+
+  SUBROUTINE scatter2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r1
+  
+
+  SUBROUTINE scatter2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r2  
+
+
+  SUBROUTINE scatter2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_r3
+    
+    
+!!!!! --> Les booleens
+
+
+  SUBROUTINE scatter2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l
+
+
+  SUBROUTINE scatter2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l1
+  
+
+  SUBROUTINE scatter2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l2  
+
+
+  SUBROUTINE scatter2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarOut,2),SIZE(VarOut,3),SIZE(VarOut,4)) :: Var_tmp    
+
+!$OMP MASTER    
+    CALL scatter2D_mpi(VarIn,Var_tmp)
+!$OMP END MASTER
+    CALL scatter_omp(Var_tmp,VarOut)
+
+  END SUBROUTINE scatter2D_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather2D_i(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i
+  
+
+  SUBROUTINE gather2D_i1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i1
+
+  
+  SUBROUTINE gather2D_i2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i2
+
+
+  SUBROUTINE gather2D_i3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather2D_r(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r
+  
+
+  SUBROUTINE gather2D_r1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r1
+
+  
+  SUBROUTINE gather2D_r2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r2
+
+
+  SUBROUTINE gather2D_r3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_r3
+  
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather2D_l(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l
+  
+
+  SUBROUTINE gather2D_l1(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l1
+
+  
+  SUBROUTINE gather2D_l2(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l2
+
+
+  SUBROUTINE gather2D_l3(VarIn, VarOut)
+    USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(klon_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+
+    CALL gather_omp(VarIn,Var_tmp)
+!$OMP MASTER
+    CALL gather2D_mpi(Var_tmp,VarOut)
+!$OMP END MASTER    
+
+  END SUBROUTINE gather2D_l3
+  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+!$OMP MASTER      
+    CALL reduce_sum_mpi(Var_tmp,VarOut)
+!$OMP END MASTER
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_phys_lmdz_transfert_para
+
Index: trunk/LMDZ.TITAN/libf/phytitan/muphys3D.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/muphys3D.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/muphys3D.F	(revision 1056)
@@ -64,4 +64,7 @@
 c------------------------------------------------------
          use dimphy
+c         use radcommon_h, only : volume,rayon,vrat,drayon,dvolume
+         USE comgeomphy,  only: rlatd
+
          IMPLICIT NONE
 #include "dimensions.h"
@@ -74,12 +77,11 @@
 
          integer iq,nmicro
-
+         real    ptimestep
+         real    pdpsrf(ngrid)
+
+c a la place de radcommon_h:
          common/part/vaer,raer,vrat,draer,dvaer
          real   vaer(nrad),raer(nrad),vrat,
      &          draer(nrad),dvaer(nrad)
-
-         real   ptimestep
- 
-         real  pdpsrf(ngrid)
 
 c*************************************
@@ -116,5 +118,5 @@
          real  q(ngrid,klev,nmicro)
          REAL taused(klev,nrad)
-         integer jsup,jinf,h,jalt,ihor,k
+         integer jsup,jinf,h,jalt,ihor,k,im1
 
 c    microphysique    *
@@ -146,19 +148,10 @@
          IF (IPREM.eq.0) THEN
  
-           IF (microfi.eq.1) THEN
-             IF (ngrid.ne.jjm+1) THEN
-               print*,"aLeRte :"
-               print*,"microfi en 2D mais ngrid.ne.jjm+1"
-               print*,ngrid,jjm+1
-               stop "je m'arrete..."
-             ENDIF
-           ELSEIF (microfi.eq.2) THEN
              IF (ngrid.ne.klon) THEN
                print*,"aLeRte :"
-               print*,"microfi en 3D mais ngrid.ne.klon"
+               print*,"microfi, mais ngrid.ne.klon"
                print*,ngrid,klon
-               stop "je m'arrete..."
+               stop "je m'arrete... (muphys3D)"
              ENDIF
-           ENDIF
 
 c initialisation des constantes de la microphysique :
@@ -183,4 +176,9 @@
            call rdf()
 c   ici on recopie la grille dans un common specifique a la microfi... 
+c          v_e    = volume
+c          r_e    = rayon
+c          vrat_e = vrat
+c          dr_e   = drayon
+c          dv_e   = dvolume
            v_e    = vaer
            r_e    = raer
@@ -221,7 +219,23 @@
 c correpondance des couches / sens GCM > microphysique 
 c-----------------------------------------------------
-c
+
+c***************************************************************
          do IHOR=1,NGRID ! GRANDE BOUCLE HORIZONTALE / SEPARATION DES COLONNES
 
+         if (IHOR.eq.1) then 
+           im1=1
+         else
+           im1=IHOR-1
+         endif
+
+c***************************************************************
+c On refait les calculs si on est au premier point
+c         OU            si on change de latitude
+c         OU            si on calcule la microfi en 3D
+c***************************************************************
+        if((IHOR.eq.1)    
+     & .or.(rlatd(IHOR).ne.rlatd(im1))
+     & .or.(microfi.eq.2)) then
+c***************************************************************
   
 c  Ici, on initialise la grille verticale et les 
@@ -415,5 +429,21 @@
            endif
 
+c***************************************************************
+         else      ! same latitude, we don't do calculations again
+           q(ihor,:,:)       = q(im1,:,:)
+           tau_aer(ihor,:,:) = tau_aer(im1,:,:)
+           prec(ihor,:)    = prec(im1,:)
+           if (clouds.eq.1) then
+             solesp(ihor,:,:)   = solesp(im1,:,:)
+             flxesp_i(ihor,:,:) = flxesp_i(im1,:,:)
+             tau_drop(ihor,:) = tau_drop(im1,:)
+             gaz1(ihor,:) = gaz1(im1,:)
+             gaz2(ihor,:) = gaz2(im1,:)
+             gaz3(ihor,:) = gaz3(im1,:)
+           endif
+         endif
+
          ENDDO             ! Fin de la boucle IHOR
+c***************************************************************
 
 102      CONTINUE           ! la premiere fois, c'est une boucle vide!
Index: trunk/LMDZ.TITAN/libf/phytitan/n_acethylene.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/n_acethylene.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/n_acethylene.F	(revision 1056)
@@ -95,5 +95,4 @@
 #include "varmuphy.h"
 
-
       integer ng,nalt
       parameter(ng=1,nalt=llm)
@@ -163,8 +162,7 @@
 
 c     Variables for latent heat release
-      real lw,cpp
+      real lw
       data lw / 581.e+3/
-      data cpp/1050./ ! pour etre cohérent avec le reste...
-      save lw,cpp
+      save lw
 
 
Index: trunk/LMDZ.TITAN/libf/phytitan/n_ethane.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/n_ethane.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/n_ethane.F	(revision 1056)
@@ -177,9 +177,7 @@
 
 c     Variables for latent heat release
-      real lw,cpp
+      real lw
       data lw / 581.e+3/
-c     data cpp/1044./
-      data cpp/1050./ ! pour etre cohérent avec le reste...
-      save lw,cpp
+      save lw
 
 
Index: trunk/LMDZ.TITAN/libf/phytitan/n_methane.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/n_methane.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/n_methane.F	(revision 1056)
@@ -157,9 +157,7 @@
 
 c     Variables for latent heat release
-      real lw,cpp
+      real lw
       data lw / 510.e+3/
-c     data cpp/1044./
-      data cpp/1050./ ! pour etre cohérent avec le reste...
-      save lw,cpp
+      save lw
 
 
Index: trunk/LMDZ.TITAN/libf/phytitan/newstart.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/newstart.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/newstart.F	(revision 1056)
@@ -0,0 +1,1115 @@
+C======================================================================
+      PROGRAM newstart
+c=======================================================================
+c
+c
+c   Auteur:   S. Lebonnois, 
+c    a partir des newstart/start_archive/lect_start_archive martiens
+c
+c             Derniere modif : 02/09 (ecriture des q*)
+c                              01/12 (inclusion dans svn dyn3d)
+c
+c   Objet:  Modify the grid for the initial state (LMD GCM VENUS/TITAN)
+c   -----           (from file NetCDF start_archive.nc)
+c
+c
+c=======================================================================
+
+      use IOIPSL
+      USE filtreg_mod
+      USE startvar
+      USE control_mod
+      USE infotrac
+      use cpdet_mod, only: ini_cpdet,t2tpot
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissnew.h"
+#include "comvert.h"
+#include "comgeom2.h"
+#include "logic.h"
+#include "temps.h"
+#include "ener.h"
+#include "description.h"
+#include "serre.h"
+#include "dimsoil.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c Variables pour fichier "ini"
+c------------------------------------
+      INTEGER   imold,jmold,lmold,nqold,ip1jmp1old
+      INTEGER   length
+      parameter (length = 100)
+      real      tab_cntrl(2*length) 
+      INTEGER isoil,iq,iqmax
+      CHARACTER*2   str2
+
+c Variable histoire 
+c------------------
+      REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
+      REAL teta(iip1,jjp1,llm),ps(iip1,jjp1)
+      REAL phis(iip1,jjp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:):: q! champs advectes
+      REAL tab_cntrl_dyn(length) ! tableau des parametres de start
+
+c variable physique
+c------------------
+      integer    ngridmx
+      parameter (ngridmx=(2+(jjm-1)*iim - 1/jjm))
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      real rlat(ngridmx),rlon(ngridmx)
+      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx)
+      REAL albe(ngridmx),radsol(ngridmx),sollw(ngridmx)
+      real solsw(ngridmx),dlw(ngridmx)
+      REAL zmea(ngridmx), zstd(ngridmx)
+      REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx)
+      REAL zpic(ngridmx), zval(ngridmx)
+      real t_fi(ngridmx,llm)
+
+c Variable nouvelle grille naturelle au point scalaire
+c------------------------------------------------------
+      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
+      REAL p3d(iip1,jjp1,llm+1)            ! pression aux interfaces
+      REAL phisold_newgrid(iip1,jjp1)
+      REAL T(iip1,jjp1,llm)
+      real rlonS(iip1,jjp1),rlatS(iip1,jjp1)
+      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
+      real albeS(ip1jmp1),radsolS(ip1jmp1),sollwS(ip1jmp1)
+      real solswS(ip1jmp1),dlwS(ip1jmp1)
+      real zmeaS(ip1jmp1),zstdS(ip1jmp1),zsigS(ip1jmp1)
+      real zgamS(ip1jmp1),ztheS(ip1jmp1),zpicS(ip1jmp1)
+      real zvalS(ip1jmp1)
+
+      real ptotal
+
+c Var intermediaires : vent naturel, mais pas coord scalaire
+c-----------------------------------------------------------
+      real vnat(iip1,jjm,llm),unat(iip1,jjp1,llm)
+
+      REAL pks(iip1,jjp1)                      ! exner (f pour filtre)
+      REAL pk(iip1,jjp1,llm)
+      REAL pkf(iip1,jjp1,llm)
+      REAL alpha(iip1,jjp1,llm),beta(iip1,jjp1,llm)
+
+
+c Variable de l'ancienne grille 
+c---------------------------------------------------------
+
+      real, dimension(:),     allocatable :: rlonuold, rlatvold
+      real, dimension(:),     allocatable :: rlonvold, rlatuold
+      real, dimension(:),     allocatable :: nivsigsold,nivsigold
+      real, dimension(:),     allocatable :: apold,bpold
+      real, dimension(:),     allocatable :: presnivsold
+      real, dimension(:,:,:), allocatable :: uold,vold,told
+      real, dimension(:,:,:,:), allocatable :: qold
+      real, dimension(:,:,:), allocatable :: tsoilold
+      real, dimension(:,:),   allocatable :: psold,phisold
+      real, dimension(:,:),   allocatable :: tsurfold
+      real, dimension(:,:),   allocatable :: albeold,radsolold
+      real, dimension(:,:),   allocatable :: sollwold,solswold
+      real, dimension(:,:),   allocatable :: dlwold
+      real, dimension(:,:),   allocatable :: zmeaold,zstdold,zsigold
+      real, dimension(:,:),   allocatable :: zgamold,ztheold,zpicold
+      real, dimension(:,:),   allocatable :: zvalold
+
+      real ptotalold
+
+c Variable intermediaires iutilise pour l'extrapolation verticale 
+c----------------------------------------------------------------
+      real, dimension(:,:,:), allocatable :: var,varp1 
+
+c divers local
+c-----------------
+
+      integer ierr,nid,nvarid
+      INTEGER ij, l,i,j
+      character*80      fichnom      
+      integer, dimension(4) :: start,counter
+      REAL phisinverse(iip1,jjp1)  ! geopotentiel au sol avant inversion
+      logical topoflag,albedoflag
+      real    albedo
+      
+c=======================================================================
+c  INITIALISATIONS DIVERSES
+c=======================================================================
+
+c VENUS/TITAN
+
+        iflag_trac = 1
+c-----------------------------------------------------------------------
+c   Initialisation des traceurs
+c   ---------------------------
+c  Choix du nombre de traceurs et du schema pour l'advection
+c  dans fichier traceur.def, par default ou via INCA
+      call infotrac_init
+
+c Allocation de la tableau q : champs advectes   
+      allocate(q(iip1,jjp1,llm,nqtot))
+
+c-----------------------------------------------------------------------
+c   Ouverture du fichier a modifier (start_archive.nc)
+c-----------------------------------------------------------------------
+
+        write(*,*) 'Creation d un etat initial a partir de'
+        write(*,*) './start_archive.nc'
+        write(*,*)
+        fichnom = 'start_archive.nc'
+        ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+        IF (ierr.NE.NF_NOERR) THEN
+          write(6,*)' Pb d''ouverture du fichier ',fichnom
+          write(6,*)' ierr = ', ierr
+          CALL ABORT
+        ENDIF
+ 
+c-----------------------------------------------------------------------
+c Lecture du tableau des parametres du run (pour la dynamique)
+c-----------------------------------------------------------------------
+
+        write(*,*) 'lecture tab_cntrl START_ARCHIVE'
+c
+        ierr = NF_INQ_VARID (nid, "controle", nvarid)
+#ifdef NC_DOUBLE
+        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
+#else
+        ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
+#endif
+c
+      write(*,*) 'Impression de tab_cntrl'
+      do i=1,200
+        write(*,*) i,tab_cntrl(i)
+      enddo
+      
+c-----------------------------------------------------------------------
+c		Initialisation des constantes
+c-----------------------------------------------------------------------
+
+      imold      = tab_cntrl(1)
+      jmold      = tab_cntrl(2)
+      lmold      = 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)
+
+      IF ( tab_cntrl(24).EQ.1. )  THEN
+        fxyhypb  = . TRUE .
+        dzoomx   = tab_cntrl(25)
+        dzoomy   = tab_cntrl(26)
+        taux     = tab_cntrl(28)
+        tauy     = tab_cntrl(29)
+      ELSE
+        fxyhypb = . FALSE .
+        ysinus  = . FALSE .
+        IF( tab_cntrl(27).EQ.1. ) ysinus = . TRUE.
+      ENDIF
+
+      ptotalold  = tab_cntrl(2*length)
+
+      write(*,*) "Old dimensions:"
+      write(*,*) "longitude: ",imold
+      write(*,*) "latitude: ",jmold
+      write(*,*) "altitude: ",lmold
+      write(*,*) 
+
+      ip1jmp1old = (imold+1-1/imold)*(jmold+1-1/jmold)
+      
+c dans run.def
+      CALL getin('planet_type',planet_type)
+      call ini_cpdet
+
+c=======================================================================
+c   CHANGEMENT DE CONSTANTES CONTENUES DANS tab_cntrl
+c=======================================================================
+c  changement de la resolution dans le fichier de controle
+      tab_cntrl(1)  = REAL(iim)
+      tab_cntrl(2)  = REAL(jjm)
+      tab_cntrl(3)  = REAL(llm)
+
+c--------------------------------
+c We use a specific run.def to read new parameters that need to be changed
+c--------------------------------
+      
+c Changement de cpp:
+      CALL getin('cpp',cpp)
+      kappa = (8.314511/43.44E-3)/cpp
+      tab_cntrl(9)  = cpp
+      tab_cntrl(10) = kappa
+
+c CHANGING THE ZOOM PARAMETERS TO CHANGE THE GRID
+      CALL getin('clon',clon)
+      CALL getin('clat',clat)
+      tab_cntrl(20) = clon
+      tab_cntrl(21) = clat
+      CALL getin('grossismx',grossismx)
+      CALL getin('grossismy',grossismy)
+      tab_cntrl(22) = grossismx
+      tab_cntrl(23) = grossismy
+      CALL getin('fxyhypb',fxyhypb)
+      IF ( fxyhypb )  THEN
+        CALL getin('dzoomx',dzoomx)
+        CALL getin('dzoomy',dzoomy)
+        tab_cntrl(25) = dzoomx
+        tab_cntrl(26) = dzoomy
+        CALL getin('taux',taux)
+        CALL getin('tauy',tauy)
+        tab_cntrl(28) = taux
+        tab_cntrl(29) = tauy
+      ELSE
+        CALL getin('ysinus',ysinus)
+        tab_cntrl(27) = ysinus
+      ENDIF
+
+c changes must be done BEFORE these lines...
+      DO l=1,length
+         tab_cntrl_dyn(l)= tab_cntrl(l)
+         tab_cntrl_fi(l) = tab_cntrl(l+length)
+      ENDDO
+
+c-----------------------------------------------------------------------
+c	Autres initialisations 
+c-----------------------------------------------------------------------
+
+      CALL iniconst 
+      CALL inigeom
+      call inifilr
+
+c-----------------------------------------------------------------------
+c		Allocations des anciennes variables
+c-----------------------------------------------------------------------
+
+      allocate(rlonuold(imold+1), rlatvold(jmold))
+      allocate(rlonvold(imold+1), rlatuold(jmold+1))
+      allocate(nivsigsold(lmold+1),nivsigold(lmold))
+      allocate(apold(lmold),bpold(lmold))
+      allocate(presnivsold(lmold))
+      allocate(uold(imold+1,jmold+1,lmold))
+      allocate(vold(imold+1,jmold+1,lmold))
+      allocate(told(imold+1,jmold+1,lmold))
+      allocate(qold(imold+1,jmold+1,lmold,nqtot))
+      allocate(psold(imold+1,jmold+1))
+      allocate(phisold(imold+1,jmold+1))
+      allocate(tsurfold(imold+1,jmold+1))
+      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
+      allocate(albeold(imold+1,jmold+1),radsolold(imold+1,jmold+1))
+      allocate(sollwold(imold+1,jmold+1),solswold(imold+1,jmold+1))
+      allocate(dlwold(imold+1,jmold+1))
+      allocate(zmeaold(imold+1,jmold+1),zstdold(imold+1,jmold+1))
+      allocate(zsigold(imold+1,jmold+1),zgamold(imold+1,jmold+1))
+      allocate(ztheold(imold+1,jmold+1),zpicold(imold+1,jmold+1))
+      allocate(zvalold(imold+1,jmold+1))
+
+      allocate(var (imold+1,jmold+1,llm))
+      allocate(varp1 (imold+1,jmold+1,llm+1))
+
+      print*,"Initialisations OK"
+
+c-----------------------------------------------------------------------
+c Lecture des longitudes et latitudes
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <rlonv> est absent de start.nc"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <rlatu> est absent de start.nc"
+         CALL abort
+      ENDIF 
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <rlonu> est absent de start.nc"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonuold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonuold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <rlatv> est absent de start.nc"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatvold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatvold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Lecture echouee pour <rlatv>"
+         CALL abort
+      ENDIF
+c
+
+      print*,"Lecture lon/lat OK"
+
+c-----------------------------------------------------------------------
+c Lecture des niveaux verticaux
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "nivsigs", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <nivsigs> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, nivsigsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, nivsigsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <nivsigs>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "nivsig", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <nivsig> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, nivsigold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, nivsigold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <nivsig>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ap", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <ap> est absent de start.nc"
+         CALL abort
+      ELSE
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, apold)
+#else
+         ierr = NF_GET_VAR_REAL(nid, nvarid, apold)
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "new_grid: Lecture echouee pour <ap>"
+         ENDIF
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "bp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <bp> est absent de start.nc"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bpold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bpold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Lecture echouee pour <bp>"
+         CALL abort
+      END IF
+
+      ierr = NF_INQ_VARID (nid, "presnivs", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <presnivs> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, presnivsold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, presnivsold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <presnivs>"
+         CALL abort
+      ENDIF
+
+c-----------------------------------------------------------------------
+c Lecture geopotentiel au sol
+c-----------------------------------------------------------------------
+c
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Le champ <phisinit> est absent de start.nc"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phisold)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, phisold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "new_grid: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+      print*,"Lecture niveaux et geopot OK"
+
+c-----------------------------------------------------------------------
+c Lecture des champs 2D ()
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,0/)
+      counter=(/imold+1,jmold+1,1,0/)
+
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <ps> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,psold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,psold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <ps>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <tsurf> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,tsurfold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,tsurfold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
+         CALL abort
+      ENDIF
+c
+      do isoil=1,nsoilmx
+         write(str2,'(i2.2)') isoil
+c
+         ierr = NF_INQ_VARID (nid, "Tsoil"//str2, nvarid)
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .              Le champ <","Tsoil"//str2,"> est absent"
+            CALL abort
+         ENDIF
+#ifdef NC_DOUBLE
+         ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,
+     .          tsoilold(1,1,isoil))
+#else
+         ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,
+     .          tsoilold(1,1,isoil))
+#endif
+         IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "lect_start_archive: 
+     .            Lecture echouee pour <","Tsoil"//str2,">"
+            CALL abort
+         ENDIF
+      end do
+c
+      ierr = NF_INQ_VARID (nid, "albe", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <albe> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,albeold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,albeold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <albe>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "radsol", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <radsol> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,radsolold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,radsolold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <radsol>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <sollw> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,sollwold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,sollwold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <sollw>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <solsw> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,solswold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,solswold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <solsw>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "dlw", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <dlw> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,dlwold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,dlwold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <dlw>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zmea", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zmea> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         zmeaold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,zmeaold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,zmeaold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zmea>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zstd", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zstd> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         zstdold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,zstdold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,zstdold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zstd>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zsig", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zsig> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         zsigold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,zsigold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,zsigold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zsig>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zgam", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zgam> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         zgamold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,zgamold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,zgamold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zgam>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zthe", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zthe> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         ztheold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,ztheold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,ztheold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zthe>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zpic", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zpic> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         zpicold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,zpicold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,zpicold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zpic>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid, "zval", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <zval> est absent"
+         PRINT*, "          Il est donc initialise a zero"
+         zvalold=0.
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,zvalold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,zvalold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <zval>"
+         CALL abort
+      ENDIF
+c
+
+      print*,"Lecture champs 2D OK"
+
+c-----------------------------------------------------------------------
+c	Lecture des champs 3D ()
+c-----------------------------------------------------------------------
+
+      start=(/1,1,1,1/)
+      counter=(/imold+1,jmold+1,lmold,1/)
+c
+      ierr = NF_INQ_VARID (nid,"temp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <temp> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid, start, counter, told)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid, start, counter, told)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <temp>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"u", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <u> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,uold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,uold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <u>"
+         CALL abort
+      ENDIF
+c
+      ierr = NF_INQ_VARID (nid,"v", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Le champ <v> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,counter,vold)
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,vold)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "lect_start_archive: Lecture echouee pour <v>"
+         CALL abort
+      ENDIF
+c
+
+c TNAME: IL EST LU A PARTIR DE traceur.def (mettre l'ancien si
+c                changement du nombre de traceurs)
+
+      IF(iflag_trac.eq.1) THEN
+      DO iq=1,nqtot
+        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
+            PRINT*, "          Il est donc initialise a zero"
+            qold(:,:,:,iq)=0.
+        ELSE
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,counter,qold(1,1,1,iq))
+#else
+      ierr = NF_GET_VARA_REAL(nid, nvarid,start,counter,qold(1,1,1,iq))
+#endif
+          IF (ierr .NE. NF_NOERR) THEN
+             PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
+             CALL abort
+          ENDIF
+        ENDIF
+      ENDDO
+      ENDIF
+
+
+      print*,"Lecture champs 3D OK"
+
+c=======================================================================
+c   INTERPOLATION DANS LA NOUVELLE GRILLE et initialisation des variables
+c=======================================================================
+c  Interpolation horizontale puis passage dans la grille physique pour 
+c  les variables physique 
+c  Interpolation verticale puis horizontale pour chaque variable 3D
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c	Variable 2d :
+c-----------------------------------------------------------------------
+
+c Relief 
+! topoflag = F: we keep the existing topography
+!          = T: we read it from the Relief.nc file
+! topoflag need to be in the specific run.def for newstart
+       topoflag = . FALSE .
+       CALL getin('topoflag',topoflag)
+
+       IF ( topoflag ) then
+         print*,"Topography (phis) read in file Relief.nc"
+         print*,"For Venus, map directly inverted in Relief.nc"
+         CALL startget_phys2d('surfgeo',iip1,jjp1,rlonv,rlatu,phis,0.0,
+     .                jjm ,rlonu,rlatv,.true.)
+c needed ?
+          phis(iip1,:) = phis(1,:)
+
+         CALL startget_phys1d('zmea',iip1,jjp1,rlonv,rlatu,ngridmx,zmea,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+         CALL startget_phys1d('zstd',iip1,jjp1,rlonv,rlatu,ngridmx,zstd,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+         CALL startget_phys1d('zsig',iip1,jjp1,rlonv,rlatu,ngridmx,zsig,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+         CALL startget_phys1d('zgam',iip1,jjp1,rlonv,rlatu,ngridmx,zgam,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+         CALL startget_phys1d('zthe',iip1,jjp1,rlonv,rlatu,ngridmx,zthe,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+         CALL startget_phys1d('zpic',iip1,jjp1,rlonv,rlatu,ngridmx,zpic,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+         CALL startget_phys1d('zval',iip1,jjp1,rlonv,rlatu,ngridmx,zval,
+     .            0.0,jjm,rlonu,rlatv,.true.)
+
+       ELSE
+          print*,'Using existing topography'
+          call interp_horiz (phisold,phis,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+          call interp_horiz (zmeaold,zmeaS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,zmeaS,zmea)
+          call interp_horiz (zstdold,zstdS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,zstdS,zstd)
+          call interp_horiz (zsigold,zsigS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,zsigS,zsig)
+          call interp_horiz (zgamold,zgamS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,zgamS,zgam)
+          call interp_horiz (ztheold,ztheS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,ztheS,zthe)
+          call interp_horiz (zpicold,zpicS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,zpicS,zpic)
+          call interp_horiz (zvalold,zvalS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+          call gr_dyn_fi (1,iip1,jjp1,ngridmx,zvalS,zval)
+       ENDIF
+
+       print*,"New surface geopotential OK"
+
+c Lat et lon pour physique
+      do i=1,iip1
+        rlatS(i,:)=rlatu(:)*180./pi
+      enddo
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,rlatS,rlat)
+
+      do j=2,jjm
+        rlonS(:,j)=rlonv(:)*180./pi
+      enddo
+      rlonS(:,1)=0.
+      rlonS(:,jjp1)=0.
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,rlonS,rlon)
+
+c Temperature de surface
+      call interp_horiz (tsurfold,tsurfS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,tsurfS,tsurf)
+c     write(44,*) 'tsurf', tsurf
+
+c Temperature du sous-sol
+      call interp_horiz(tsoilold,tsoilS,
+     &                  imold,jmold,iim,jjm,nsoilmx,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (nsoilmx,iip1,jjp1,ngridmx,tsoilS,tsoil)
+c     write(45,*) 'tsoil',tsoil
+
+! CHANGING ALBEDO: may be done through run.def
+       albedoflag = . FALSE .
+       CALL getin('albedoflag',albedoflag)
+
+       IF ( albedoflag ) then
+         print*,"Albedo is reinitialized to the albedo value in run.def"
+         print*,"We may want to consider a map later on..."
+         albedo=0.1
+         CALL getin('albedo',albedo)
+         albe=albedo
+       ELSE
+         call interp_horiz (albeold,albeS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+         call gr_dyn_fi (1,iip1,jjp1,ngridmx,albeS,albe)
+       ENDIF
+
+      call interp_horiz (radsolold,radsolS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,radsolS,radsol)
+
+      call interp_horiz (sollwold,sollwS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,sollwS,sollw)
+
+      call interp_horiz (solswold,solswS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,solswS,solsw)
+
+      call interp_horiz (dlwold,dlwS,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call gr_dyn_fi (1,iip1,jjp1,ngridmx,dlwS,dlw)
+
+      print*,"Nouvelles var physiques OK"
+
+c-----------------------------------------------------------------------
+c	Traitement special de la pression au sol :
+c-----------------------------------------------------------------------
+
+c  Extrapolation la pression dans la nouvelle grille
+      call interp_horiz(psold,ps,imold,jmold,iim,jjm,1,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+
+c	On assure la conservation de la masse de l'atmosphere 
+c--------------------------------------------------------------
+
+      ptotal =  0.
+      DO j=1,jjp1
+         DO i=1,iim
+            ptotal=ptotal+ps(i,j)*aire(i,j)/g
+         END DO
+      END DO
+
+      write(*,*)
+      write(*,*)'Ancienne grille: masse de l atm :',ptotalold
+      write(*,*)'Nouvelle grille: masse de l atm :',ptotal
+      write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold 
+      write(*,*)
+
+
+      DO j=1,jjp1
+         DO i=1,iip1
+            ps(i,j)=ps(i,j) * ptotalold/ptotal
+         END DO
+      END DO
+
+c la pression de surface et les temperatures ne sont pas reequilibrees en fonction
+c de la nouvelle topographie... 
+c Si l'ajustement inevitable du debut pose des problemes, voir le newstart martien.
+
+      print*,"Nouvelle ps OK"
+      print*,"If changes done on topography, beware !"
+      print*,"Some time may be needed for adjustments at the beginning"
+      print*,"so if unstable, relax the timestep and/or dissipation."
+
+c-----------------------------------------------------------------------
+c	Variable 3d :
+c-----------------------------------------------------------------------
+
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+         if (disvert_type==1) then
+           CALL exner_hyb(  ip1jmp1, ps, p3d,alpha,beta,pks, pk, pkf )
+         else ! we assume that we are in the disvert_type==2 case
+           CALL exner_milieu( ip1jmp1, ps, p3d, beta, pks, pk, pkf )
+         endif
+      
+c temperatures atmospheriques
+
+c ATTENTION: peut servir, mais bon...
+c modif: profil uniforme
+c     do l=1,lmold
+c      do j=1,jmold+1
+c       do i=1,imold+1
+c          told(i,j,l)=told(1,jmold/2,l)
+c       enddo
+c      enddo
+c     enddo
+
+      write (*,*) 'told ', told (1,jmold+1,1)  ! INFO
+      call interp_vert
+     &    (told,var,lmold,llm,apold,bpold,ap,bp,
+     &     psold,(imold+1)*(jmold+1))
+      write (*,*) 'var ', var (1,jmold+1,1)  ! INFO
+      call interp_horiz(var,t,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'T ', T(1,jjp1,1)  ! INFO
+! pour info:
+! Si extension verticale, la T est extrapolee constante au-dessus de lmold
+
+c passage grille physique pour restartphy.nc 
+      call gr_dyn_fi (llm,iip1,jjp1,ngridmx,T,t_fi)
+
+! ADAPTATION GCM POUR CP(T)
+c passage en temperature potentielle
+      call t2tpot(ip1jmp1*llm,T,teta,pk)
+c on assure la periodicite
+      teta(iip1,:,:) =  teta(1,:,:)
+
+c calcul des champ de vent; passage en vent covariant
+      write (*,*) 'uold ', uold (1,2,1)  ! INFO
+      call interp_vert
+     & (uold,var,lmold,llm,apold,bpold,ap,bp,
+     &  psold,(imold+1)*(jmold+1))
+      write (*,*) 'var ', var (1,2,1)  ! INFO
+      call interp_horiz(var,us,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      write (*,*) 'us ', us (1,2,1)   ! INFO
+
+      call interp_vert
+     & (vold,var,lmold,llm,
+     &  apold,bpold,ap,bp,psold,(imold+1)*(jmold+1))
+      call interp_horiz(var,vs,imold,jmold,iim,jjm,llm,
+     &                   rlonuold,rlatvold,rlonu,rlatv)
+      call scal_wind(us,vs,unat,vnat)
+      write (*,*) 'unat ', unat (1,2,1)    ! INFO
+      do l=1,llm
+        do j = 1, jjp1
+          do i=1,iip1
+            ucov( i,j,l ) = unat( i,j,l ) * cu(i,j)
+! pour info:
+! Si extension verticale, on impose u=0 au-dessus de lmold
+            if (l.gt.lmold) ucov( i,j,l ) = 0
+          end do
+        end do
+      end do 
+      write (*,*) 'ucov ', ucov (1,2,1)  ! INFO
+c     write(48,*) 'ucov',ucov
+      do l=1,llm
+        do j = 1, jjm
+          do i=1,iim
+            vcov( i,j,l ) = vnat( i,j,l ) * cv(i,j)
+! pour info:
+! Si extension verticale, on impose v=0 au-dessus de lmold
+            if (l.gt.lmold) vcov( i,j,l ) = 0
+          end do
+          vcov( iip1,j,l ) = vcov( 1,j,l )
+        end do
+      end do
+c     write(49,*) 'ucov',vcov
+
+c masse: on la recalcule (ps a été ajustée pour conserver la masse totale)
+      call massdair(p3d,masse)
+      
+c traceurs 3D
+      do  iq = 1, nqtot
+            call interp_vert(qold(1,1,1,iq),var,lmold,llm,
+     &        apold,bpold,ap,bp,psold,(imold+1)*(jmold+1))
+            call interp_horiz(var,q(1,1,1,iq),imold,jmold,iim,jjm,llm,
+     &                  rlonuold,rlatvold,rlonu,rlatv)
+      enddo
+
+      print*,"Nouvelles var dynamiques OK"
+
+c=======================================================================
+c    Ecriture des restart.nc et restartphy.nc :
+c=======================================================================
+
+      call writerestart('restart.nc',tab_cntrl_dyn,
+     .                    phis,vcov,ucov,teta,masse,q,ps)
+
+      print*,"restart OK"
+
+      call writerestartphy('restartphy.nc',tab_cntrl_fi,ngridmx,llm,
+     .           rlat,rlon,tsurf,tsoil,albe,solsw, sollw,dlw,
+     .           radsol,
+     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .           t_fi)
+
+      print*,"restartphy OK"
+
+      end
Index: trunk/LMDZ.TITAN/libf/phytitan/optci.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/optci.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/optci.F	(revision 1056)
@@ -2,4 +2,5 @@
       use dimphy
       use infotrac
+      use common_mod, only:rmcbar,xfbar,ncount,TauHID,TauCID,TauGID
 #include "dimensions.h"
 #include "microtab.h"
@@ -42,12 +43,4 @@
      &                TAUHV(ngrid,NSPECV),TAUCV(ngrid,NSPECV),
      &                TAUGV(ngrid,NSPECV)
-
-      COMMON /TAUD/   TAUHID(ngrid,NLAYER,NSPECI)
-     &               ,TAUCID(ngrid,NLAYER,NSPECI)
-     &               ,TAUGID(ngrid,NLAYER,NSPECI)
-     &               ,TAUHVD(ngrid,NLAYER,NSPECV)
-     &               ,TAUCVD(ngrid,NLAYER,NSPECV)
-     &               ,TAUGVD(ngrid,NLAYER,NSPECV)
-
 
       COMMON /OPTICI/ DTAUI(ngrid,NLAYER,NSPECI)
@@ -70,11 +63,4 @@
       COMMON /CONST/RGAS,RHOP,PI,SIGMA
       COMMON /part/v,rayon,vrat,dr,dv
-
-c-----Rayons nuages et "composition" de la goutte
-c     sur la grille ...
-      integer ncount(ngrid,NLAYER)
-      real    rmcbar(ngrid,NLAYER)
-      real    xfbar(ngrid,NLAYER,4)
-      COMMON/rnuabar/ncount,rmcbar,xfbar
 
       DIMENSION PROD(NLEVEL)
@@ -164,5 +150,6 @@
       DO 420 K=1,NSPECI
 C LETS USE THE THOLIN OPTICAL CONSTANTS FOR THE HAZE.
-          CALL THOLIN(WLNI(K),TNR,TNI)
+c         CALL THOLIN(WLNI(K),TNR,TNI)
+          CALL THOLIN_CVD(WLNI(K),TNR,TNI)
           REALI(K)=TNR
           XIMGI(K)=TNI*FHIR
@@ -293,7 +280,7 @@
         TAUGI(ig,:)    = TAUGI_1pt(:) 
 
-        TAUHID(ig,:,:) = TAUHID_1pt(:,:) 
-        TAUCID(ig,:,:) = TAUCID_1pt(:,:) 
-        TAUGID(ig,:,:) = TAUGID_1pt(:,:) 
+        TauHID(ig,:,:) = TAUHID_1pt(:,:) 
+        TauCID(ig,:,:) = TAUCID_1pt(:,:) 
+        TauGID(ig,:,:) = TAUGID_1pt(:,:) 
 
 c************************************************************************
Index: trunk/LMDZ.TITAN/libf/phytitan/optci_1pt_3.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/optci_1pt_3.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/optci_1pt_3.F	(revision 1056)
@@ -12,5 +12,5 @@
      &     ximgi, realv, ximgv, rcldi, xicldi, rcldv, xicldv, rcldi2, 
      &     xicldi2, rcldv2, xicldv2,real bwni, wnoi, dwni, wlni, csubp, 
-     &     rsfi, rsfv, f0pi, rhch4, fh2, fhaze, fhvis
+     &     f0pi, rhch4, fh2, fhaze, fhvis
      &     reali, ximgi, bwni, fhir, taufac, rcloud, fargon, rgas, rhop,
      &     pi, sigma, prod,reali,fhvis
@@ -55,5 +55,5 @@
      &                DWNI(NSPECI), WLNI(NSPECI)
 
-      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /PLANT/ CSUBP,F0PI
       COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
       COMMON /CONST/RGAS,RHOP,PI,SIGMA
@@ -99,5 +99,4 @@
           DO 100 J=1,NLAYER    ! BOUCLE SUR L'ALTITUDE
 c************************************************************************
-c      print*,'ig,k,j ',ig,k,j
 
 C SET UP THE COEFFICIENT TO REDUCE MASS PATH TO STP ...SEE NOTES
@@ -282,11 +281,4 @@
 c     TAEROSCAT=xv2(j,k)
 c     CBAR=xv3(j,k)
-
-c     if (ig.eq.1) then
-c     if (k.eq.NSPECV/2) then
-c      print*,'@IR',K,J,TAEROS,TAEROSCAT,CBAR
-c     stop'Pour faire des comparaisons'
-c     endif
-c     endif
 
 
@@ -337,7 +329,5 @@
        TAUGAS=0.0
        IF (WNOI(K) .LT. 940. ) THEN
-c        if(ig.eq.1.and.k.eq.nspecv/2) print*,'avant PIA'
                  CALL PIA(K,TBAR,PNN,PCC,PCN,PHN)
-c        if(ig.eq.1.and.k.eq.nspecv/2) print*,'apres PIA'
 C HERE IS WHERE WE COULD SCALE THE PIA COEFFICEINTS TO FIT DATA
 C BASED ON REGIS' NOTES. ---TGM HAS THIS ADJUST IN IT AS DEFAULT
@@ -360,5 +350,4 @@
 C     ??FLAG? HERE MUST BE WATCHED CAREFULLY
                      U=COLDEN(J)*6.02204E23/BMU
-          if(ig.eq.1.and.k.eq.nspecv/2) print*,'Avant GAS2'
                      if((ylellouch).or.(.not.hcnrad)) then
                        CALL GAS2_NOHCN(J, KGAS,TBAR,PBAR,U,TAU2)
@@ -366,5 +355,4 @@
                        CALL GAS2(J, KGAS,TBAR,PBAR,U,TAU2)
                      endif
-          if(ig.eq.1.and.k.eq.nspecv/2) print*,'Apres GAS2'
                      TAUGAS=TAUGAS+TAU2
        ENDIF
@@ -457,5 +445,4 @@
 c 195    CONTINUE
 
-c        IF(ig.eq.12) WRITE (6,240) TAUI_1pt(NLEVEL,K)
 c 200    CONTINUE
 
Index: trunk/LMDZ.TITAN/libf/phytitan/optcv.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/optcv.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/optcv.F	(revision 1056)
@@ -3,4 +3,5 @@
       use dimphy
       use infotrac
+      use common_mod, only:rmcbar,xfbar,ncount,TauHVD,TauCVD,TauGVD
 #include "dimensions.h"
 #include "microtab.h"
@@ -41,11 +42,4 @@
      &               ,TAUHV(ngrid,NSPECV) ,TAUCV(ngrid,NSPECV)
      &               ,TAUGV(ngrid,NSPECV)
-
-      COMMON /TAUD/   TAUHID(ngrid,NLAYER,NSPECI)
-     &               ,TAUCID(ngrid,NLAYER,NSPECI)
-     &               ,TAUGID(ngrid,NLAYER,NSPECI)
-     &               ,TAUHVD(ngrid,NLAYER,NSPECV)
-     &               ,TAUCVD(ngrid,NLAYER,NSPECV)
-     &               ,TAUGVD(ngrid,NLAYER,NSPECV)
 
       COMMON /OPTICV/ DTAUV(ngrid,NLAYER,NSPECV,4)
@@ -65,11 +59,4 @@
       COMMON /CONST/ RGAS,RHOP,PI,SIGMA
       COMMON /part/ v(nrad),rayon(nrad),vrat,dr(nrad),dv(nrad)
-
-c-----Rayons nuages et "composition" de la goutte
-c     sur la grille ...
-      integer ncount(ngrid,NLAYER)
-      real    rmcbar(ngrid,NLAYER)
-      real    xfbar(ngrid,NLAYER,4)
-      COMMON/rnuabar/ncount,rmcbar,xfbar
 
       REAL xv1(klev,NSPECV)
@@ -136,5 +123,6 @@
       DO 130 K=1,NSPECV
 C LETS USE THE OPTICAL CONSTANTS FOR THOLIN
-      CALL THOLIN(WLNV(K),TNR,TNI)
+c     CALL THOLIN(WLNV(K),TNR,TNI)
+      CALL THOLIN_CVD(WLNV(K),TNR,TNI)
       REALV(K)=TNR
       XIMGV(K)=TNI*FHVIS
@@ -228,7 +216,7 @@
         TAUGV(ig,:)    = TAUGV_1pt(:) 
 
-        TAUHVD(ig,:,:) = TAUHVD_1pt(:,:) 
-        TAUCVD(ig,:,:) = TAUCVD_1pt(:,:) 
-        TAUGVD(ig,:,:) = TAUGVD_1pt(:,:) 
+        TauHVD(ig,:,:) = TAUHVD_1pt(:,:) 
+        TauCVD(ig,:,:) = TAUCVD_1pt(:,:) 
+        TauGVD(ig,:,:) = TAUGVD_1pt(:,:) 
 
  101  CONTINUE
Index: trunk/LMDZ.TITAN/libf/phytitan/optcv_1pt_3.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/optcv_1pt_3.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/optcv_1pt_3.F	(revision 1056)
@@ -12,5 +12,5 @@
      &     ximgi, realv, ximgv, rcldi, xicldi, rcldv, xicldv, rcldi2,
      &     xicldi2, rcldv2, xicldv2,real bwni, wnoi, dwni, wlni, csubp,
-     &     rsfi, rsfv, f0pi, rhch4, fh2, fhaze, fhvis
+     &     f0pi, rhch4, fh2, fhaze, fhvis
      &     reali, ximgi, bwni, fhir, taufac, rcloud, fargon, rgas, rhop,
      &     pi, sigma, prod,reali,fhvis
@@ -58,5 +58,5 @@
      &               ,DWNV(NSPECV),WLNV(NSPECV)
 
-      COMMON /PLANT/ CSUBP,RSFI,RSFV,F0PI
+      COMMON /PLANT/ CSUBP,F0PI
       COMMON /ADJUST/ RHCH4,FH2,FHAZE,FHVIS,FHIR,TAUFAC,RCLOUD,FARGON
       COMMON /CONST/ RGAS,RHOP,PI,SIGMA
@@ -380,5 +380,4 @@
 c          WRITE (6,120)
 c 120      FORMAT(///'  OPTICAL CONSTANTS IN THE VISIBLE (@EQUATOR) ')
-c          WRITE(6,*) 'latitude:',ig
 c          DO 200 K=1,NSPECV
 c          WRITE (6,190)
@@ -387,5 +386,4 @@
 c          WRITE (6,230)REALV(K),XIMGV(K)
 c          DO 195 J=1,NLAYER,NLAYER
-C RECALCULATE FOR PRINT OUT ONLY, ONLY FIRST NTERM AT ig=12 (EQUATOR)
 c          WRITE (6,220)XNUMB(J), WBARV_1pt(J,K,NT),COSBV_1pt(J,K,NT)
 c    &      ,DTAUV_1pt(J,K,NT),TAUV_1pt(J,K,NT)
Index: trunk/LMDZ.TITAN/libf/phytitan/orodrag.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/orodrag.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/orodrag.F	(revision 1056)
@@ -0,0 +1,362 @@
+      SUBROUTINE orodrag( nlon,nlev 
+     i                 , kgwd,  kdx, ktest
+     r                 , ptsphy
+     r                 , paphm1,papm1,pgeom1,pn2m1,ptm1,pum1,pvm1
+     r                 , pmea, pstd, psig, pgam, pthe, ppic, pval
+c outputs
+     r                 , pulow,pvlow
+     r                 , pvom,pvol,pte )
+      
+      use dimphy
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+
+c
+c
+c**** *orodrag* - does the SSO drag  parametrization.
+c
+c     purpose.
+c     --------
+c
+c     this routine computes the physical tendencies of the
+c     prognostic variables u,v  and t due to  vertical transports by
+c     subgridscale orographically excited gravity waves, and to
+c     low level blocked flow drag.
+c
+c**   interface.
+c     ----------
+c          called from *drag_noro*.
+c
+c          the routine takes its input from the long-term storage:
+c          u,v,t and p at t-1.
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c
+c kgwd- -input-I: Total nb of points where the orography schemes are active
+c ktest--input-I: Flags to indicate active points
+c kdx----input-I: Locate the physical location of an active point.
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c pn2m1---input-R-Brunt-Vaisala freq.^2 at 1/2 layers
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+
+      integer nlon,nlev,kgwd
+      real ptsphy
+
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c
+c pte -----output-R: T tendency
+c pvom-----output-R: U tendency
+c pvol-----output-R: V tendency
+c
+c
+c Implicit Arguments:
+c ===================
+c
+c klon-common-I: Number of points seen by the physics
+c klev-common-I: Number of vertical layers
+c
+c     method.
+c     -------
+c
+c     externals.
+c     ----------
+Coff  integer ismin, ismax
+Coff  external ismin, ismax
+c
+c     reference.
+c     ----------
+c
+c     author.
+c     -------
+c     m.miller + b.ritter   e.c.m.w.f.     15/06/86.
+c
+c     f.lott + m. miller    e.c.m.w.f.     22/11/94
+c-----------------------------------------------------------------------
+c
+c
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+c
+      real  pte(nlon,nlev),
+     *      pvol(nlon,nlev),
+     *      pvom(nlon,nlev),
+     *      pulow(nlon),
+     *      pvlow(nlon)
+      real  pum1(nlon,nlev),
+     *      pvm1(nlon,nlev),
+     *      ptm1(nlon,nlev),
+     *      pmea(nlon),pstd(nlon),psig(nlon),
+     *      pgam(nlon),pthe(nlon),ppic(nlon),pval(nlon),
+     *      pgeom1(nlon,nlev),pn2m1(nlon,nlev),
+     *      papm1(nlon,nlev),
+     *      paphm1(nlon,nlev+1)
+c
+      integer  kdx(nlon),ktest(nlon)
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+      integer  isect(klon),
+     *         icrit(klon),
+     *         ikcrith(klon),
+     *         ikenvh(klon),
+     *         iknu(klon),
+     *         iknu2(klon),
+     *         ikcrit(klon),
+     *         ikhlim(klon)
+c
+      real   ztau(klon,klev+1),
+     *       zstab(klon,klev+1),
+     *       zvph(klon,klev+1),
+     *       zrho(klon,klev+1),
+     *       zri(klon,klev+1),
+     *       zpsi(klon,klev+1),
+     *       zzdep(klon,klev)
+      real   zdudt(klon),
+     *       zdvdt(klon),
+     *       zdtdt(klon),
+     *       zdedt(klon),
+     *       zvidis(klon),
+     *       ztfr(klon),
+     *       znu(klon),
+     *       zd1(klon),
+     *       zd2(klon),
+     *       zdmod(klon)
+
+
+c local quantities:
+
+      integer jl,jk,ji
+      real ztmst,zdelp,ztemp,zforc,ztend,rover                
+      real zb,zc,zconb,zabsv,zzd1,ratio,zbet,zust,zvst,zdis
+   
+c
+c------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c        print *,' in orodrag'
+ 100  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.1   computational constants
+c                -----------------------
+c
+ 110  continue
+c
+c     ztmst=twodt
+c     if(nstep.eq.nstart) ztmst=0.5*twodt
+      ztmst=ptsphy
+c     ------------------------------------------------------------------
+c
+ 120  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.3   check whether row contains point for printing
+c                ---------------------------------------------
+c
+ 130  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         2.     precompute basic state variables.
+c*                ---------- ----- ----- ----------
+c*                define low level wind, project winds in plane of
+c*                low level wind, determine sector in which to take
+c*                the variance and set indicator for critical levels.
+c
+
+  200 continue
+c
+      do jk=1,klev
+       zstab(:,jk) = pn2m1(:,jk)
+      enddo
+c
+      call orosetup
+     *     ( nlon, nlev , ktest 
+     *     , ikcrit, ikcrith, icrit, isect, ikhlim, ikenvh,iknu,iknu2
+     *     , paphm1, papm1 , pum1   , pvm1 , ptm1 , pgeom1, zstab, pstd
+     *     , zrho  , zri   , ztau , zvph , zpsi, zzdep
+     *     , pulow, pvlow 
+     *     , pthe,pgam,pmea,ppic,pval,znu  ,zd1,  zd2,  zdmod )
+
+c
+c
+c
+c***********************************************************
+c
+c
+c*         3.      compute low level stresses using subcritical and
+c*                 supercritical forms.computes anisotropy coefficient
+c*                 as measure of orographic twodimensionality.
+c
+  300 continue
+c
+      call gwstress
+     *    ( nlon  , nlev
+     *    , ikcrit, isect, ikhlim, ktest, ikcrith, icrit, ikenvh, iknu
+     *    , zrho  , zstab, zvph  , pstd,  psig, pmea, ppic, pval
+     *    , ztfr   , ztau 
+     *    , pgeom1,pgam,zd1,zd2,zdmod,znu)
+
+c
+c
+c*         4.      compute stress profile including
+c                  trapped waves, wave breaking,
+c                  linear decay in stratosphere.
+c
+  400 continue
+c
+c
+
+      call gwprofil
+     *       (  nlon , nlev
+     *       , kgwd   , kdx  , ktest
+     *       , ikcrit, ikcrith, icrit  , ikenvh, iknu
+     *       ,iknu2 , paphm1, zrho   , zstab , ztfr   , zvph
+     *       , zri   , ztau 
+ 
+     *       , zdmod , znu    , psig  , pgam , pstd , ppic , pval)
+
+c
+c*         5.      Compute tendencies from waves stress profile.
+c                  Compute low level blocked flow drag. 
+c*                 --------------------------------------------
+c
+  500 continue
+
+      
+c
+c  explicit solution at all levels for the gravity wave
+c  implicit solution for the blocked levels
+
+      do 510 jl=kidia,kfdia
+      zvidis(jl)=0.0
+      zdudt(jl)=0.0
+      zdvdt(jl)=0.0
+      zdtdt(jl)=0.0
+  510 continue
+c
+
+      do 524 jk=1,klev
+c
+
+C  WAVE STRESS 
+C-------------
+c
+c
+      do 523 ji=kidia,kfdia
+
+      if(ktest(ji).eq.1) then
+
+      zdelp=paphm1(ji,jk+1)-paphm1(ji,jk)
+      ztemp=-rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,klev+1)*zdelp)
+
+      zdudt(ji)=(pulow(ji)*zd1(ji)-pvlow(ji)*zd2(ji))*ztemp/zdmod(ji)
+      zdvdt(ji)=(pvlow(ji)*zd1(ji)+pulow(ji)*zd2(ji))*ztemp/zdmod(ji)
+c
+c Control Overshoots
+c
+
+      if(jk.ge.ntop)then
+        rover=0.10
+        if(abs(zdudt(ji)).gt.rover*abs(pum1(ji,jk))/ztmst)
+     C    zdudt(ji)=rover*abs(pum1(ji,jk))/ztmst*
+     C              zdudt(ji)/(abs(zdudt(ji))+1.E-10)
+        if(abs(zdvdt(ji)).gt.rover*abs(pvm1(ji,jk))/ztmst)
+     C    zdvdt(ji)=rover*abs(pvm1(ji,jk))/ztmst*
+     C              zdvdt(ji)/(abs(zdvdt(ji))+1.E-10)
+      endif 
+
+      rover=0.25
+      zforc=sqrt(zdudt(ji)**2+zdvdt(ji)**2)        
+      ztend=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/ztmst                      
+
+      if(zforc.ge.rover*ztend)then
+        zdudt(ji)=rover*ztend/zforc*zdudt(ji)
+        zdvdt(ji)=rover*ztend/zforc*zdvdt(ji)
+      endif
+c
+c BLOCKED FLOW DRAG:
+C -----------------
+c
+      if(jk.gt.ikenvh(ji)) then
+         zb=1.0-0.18*pgam(ji)-0.04*pgam(ji)**2
+         zc=0.48*pgam(ji)+0.3*pgam(ji)**2
+         zconb=2.*ztmst*gkwake*psig(ji)/(4.*pstd(ji))
+         zabsv=sqrt(pum1(ji,jk)**2+pvm1(ji,jk)**2)/2.
+         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(zpsi(ji,jk))**2
+         ratio=(cos(zpsi(ji,jk))**2+pgam(ji)*sin(zpsi(ji,jk))**2)/
+     *   (pgam(ji)*cos(zpsi(ji,jk))**2+sin(zpsi(ji,jk))**2)
+         zbet=max(0.,2.-1./ratio)*zconb*zzdep(ji,jk)*zzd1*zabsv
+c
+c OPPOSED TO THE WIND
+c
+         zdudt(ji)=-pum1(ji,jk)/ztmst
+         zdvdt(ji)=-pvm1(ji,jk)/ztmst
+c
+c PERPENDICULAR TO THE SSO MAIN AXIS:
+C                            
+cmod     zdudt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
+cmod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
+cmod *              *cos(pthe(ji)*rpi/180.)/ztmst
+cmod     zdvdt(ji)=-(pum1(ji,jk)*cos(pthe(ji)*rpi/180.)
+cmod *              +pvm1(ji,jk)*sin(pthe(ji)*rpi/180.))
+cmod *              *sin(pthe(ji)*rpi/180.)/ztmst
+C
+         zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
+         zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
+      end if
+      pvom(ji,jk)=zdudt(ji)
+      pvol(ji,jk)=zdvdt(ji)
+      zust=pum1(ji,jk)+ztmst*zdudt(ji)
+      zvst=pvm1(ji,jk)+ztmst*zdvdt(ji)
+      zdis=0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
+      zdedt(ji)=zdis/ztmst
+      zvidis(ji)=zvidis(ji)+zdis*zdelp
+c VENUS ATTENTION: CP VARIABLE
+      zdtdt(ji)=zdedt(ji)/rcpd
+c
+c  NO TENDENCIES ON TEMPERATURE .....
+c
+c  Instead of, pte(ji,jk)=zdtdt(ji), due to mechanical dissipation
+c
+      pte(ji,jk)=0.0
+
+      endif
+
+  523 continue
+  524 continue
+c
+c
+  501 continue
+
+      return
+      end
+
Index: trunk/LMDZ.TITAN/libf/phytitan/orosetup.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/orosetup.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/orosetup.F	(revision 1056)
@@ -0,0 +1,512 @@
+      SUBROUTINE orosetup
+     *         ( nlon   , nlev  , ktest
+     *         , kkcrit, kkcrith, kcrit, ksect , kkhlim
+     *         , kkenvh, kknu  , kknu2
+     *         , paphm1, papm1 , pum1 , pvm1, ptm1, pgeom1, pstab, pstd
+     *         , prho  , pri   , ptau, pvph, ppsi, pzdep
+     *         , pulow , pvlow  
+     *         , ptheta, pgam, pmea, ppic, pval
+     *         , pnu  ,  pd1  ,  pd2  ,pdmod  )
+C
+c**** *gwsetup*
+c
+c     purpose.
+c     --------
+c     SET-UP THE ESSENTIAL PARAMETERS OF THE SSO DRAG SCHEME:
+C     DEPTH OF LOW WBLOCKED LAYER, LOW-LEVEL FLOW, BACKGROUND
+C     STRATIFICATION.....
+c
+c**   interface.
+c     ----------
+c          from *orodrag*
+c
+c        explicit arguments :
+c        --------------------
+c     ==== inputs ===
+c 
+c nlon----input-I-Total number of horizontal points that get into physics
+c nlev----input-I-Number of vertical levels
+c ktest--input-I: Flags to indicate active points
+c
+c ptsphy--input-R-Time-step (s)
+c paphm1--input-R: pressure at model 1/2 layer
+c papm1---input-R: pressure at model layer
+c pgeom1--input-R: Altitude of layer above ground
+c VENUS ATTENTION: CP VARIABLE PSTAB CALCULE EN AMONT DES PARAMETRISATIONS
+c pstab-----R-: Brunt-Vaisala freq.^2 at 1/2 layers (input except klev+1)
+c ptm1, pum1, pvm1--R-: t, u and v
+c pmea----input-R-Mean Orography (m)
+C pstd----input-R-SSO standard deviation (m)
+c psig----input-R-SSO slope
+c pgam----input-R-SSO Anisotropy
+c pthe----input-R-SSO Angle
+c ppic----input-R-SSO Peacks elevation (m)
+c pval----input-R-SSO Valleys elevation (m)
+
+c     ==== outputs ===
+c pulow, pvlow -output-R: Low-level wind
+c kkcrit----I-: Security value for top of low level flow
+c kcrit-----I-: Critical level 
+c ksect-----I-: Not used
+c kkhlim----I-: Not used
+c kkenvh----I-: Top of blocked flow layer
+c kknu------I-: Layer that sees mountain peacks
+c kknu2-----I-: Layer that sees mountain peacks above mountain mean
+c kknub-----I-: Layer that sees mountain mean above valleys
+c prho------R-: Density at 1/2 layers
+c pri-------R-: Background Richardson Number, Wind shear measured along GW stress
+c pvph------R-: Wind in  plan of GW stress, Half levels.
+c ppsi------R-: Angle between low level wind and SS0 main axis.
+c pd1-------R-| Compared the ratio of the stress
+c pd2-------R-| that is along the wind to that Normal to it.
+c               pdi define the plane of low level stress
+c               compared to the low level wind.
+c see p. 108 Lott & Miller (1997).                      
+c pdmod-----R-: Norme of pdi
+
+c     === local arrays ===
+c
+c zvpf------R-: Wind projected in the plan of the low-level stress.
+
+c     ==== outputs ===
+c
+c        implicit arguments :   none
+c        --------------------
+c
+c     method.
+c     -------
+c
+c
+c     externals.
+c     ----------
+c
+c
+c     reference.
+c     ----------
+c
+c        see ecmwf research department documentation of the "i.f.s."
+c
+c     author.
+c     -------
+c
+c     modifications.
+c     --------------
+c     f.lott  for the new-gwdrag scheme november 1993
+c
+c-----------------------------------------------------------------------
+      use dimphy
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+
+#include "YOMCST.h"
+#include "YOEGWD.h"
+
+c-----------------------------------------------------------------------
+c
+c*       0.1   arguments
+c              ---------
+c
+      integer nlon,nlev
+      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
+     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon)
+
+c
+      real paphm1(nlon,klev+1),papm1(nlon,klev),pum1(nlon,klev),
+     *     pvm1(nlon,klev),ptm1(nlon,klev),pgeom1(nlon,klev),
+     *     prho(nlon,klev+1),pri(nlon,klev+1),pstab(nlon,klev+1),
+     *     ptau(nlon,klev+1),pvph(nlon,klev+1),ppsi(nlon,klev+1),
+     *     pzdep(nlon,klev)
+       real pulow(nlon),pvlow(nlon),ptheta(nlon),pgam(nlon),pnu(nlon),
+     *     pd1(nlon),pd2(nlon),pdmod(nlon)
+      real pstd(nlon),pmea(nlon),ppic(nlon),pval(nlon)
+c
+c-----------------------------------------------------------------------
+c
+c*       0.2   local arrays
+c              ------------
+c
+c
+      integer ilevh ,jl,jk,iii
+      real zcons1,zhgeo,zu,zphi
+      real zvt1,zvt2,zdwind,zwind,zdelp
+      real zstabm,zstabp,zrhom,zrhop
+      logical lo 
+      logical ll1(klon,klev+1)
+      integer kknu(klon),kknu2(klon),kknub(klon),kknul(klon),
+     *        kentp(klon),ncount(klon)  
+c
+      real zhcrit(klon,klev),zvpf(klon,klev),
+     *     zdp(klon,klev)
+      real znorm(klon),zb(klon),zc(klon),
+     *      zulow(klon),zvlow(klon),znup(klon),znum(klon)
+
+c     ------------------------------------------------------------------
+c
+c*         1.    initialization
+c                --------------
+c
+c       PRINT *,' in orosetup'
+ 100  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         1.1   computational constants
+c                -----------------------
+c
+ 110  continue
+c
+      ilevh =klev/3
+c
+      zcons1=1./rd
+c
+c     ------------------------------------------------------------------
+c
+c*         2.
+c                --------------
+c
+ 200  continue
+c
+c     ------------------------------------------------------------------
+c
+c*         2.1     define low level wind, project winds in plane of
+c*                 low level wind, determine sector in which to take
+c*                 the variance and set indicator for critical levels.
+c
+c
+c
+      do 2001 jl=kidia,kfdia
+      kknu(jl)    =klev
+      kknu2(jl)   =klev
+      kknub(jl)   =klev
+      kknul(jl)   =klev
+      pgam(jl) =max(pgam(jl),gtsec)
+      ll1(jl,klev+1)=.false.
+ 2001 continue
+c
+c Ajouter une initialisation (L. Li, le 23fev99):
+c
+      do jk=klev,ilevh,-1
+      do jl=kidia,kfdia
+      ll1(jl,jk)= .false.
+      ENDDO
+      ENDDO
+c
+c*      define top of low level flow
+c       ----------------------------
+      do 2002 jk=klev,ilevh,-1
+      do 2003 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      lo=(paphm1(jl,jk)/paphm1(jl,klev+1)).ge.gsigcr
+      if(lo) then
+        kkcrit(jl)=jk
+      endif
+      zhcrit(jl,jk)=ppic(jl)-pval(jl)           
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+C     if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknu(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknu(jl)=ilevh
+      endif
+ 2003 continue
+ 2002 continue
+      do 2004 jk=klev,ilevh,-1
+      do 2005 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=ppic(jl)-pmea(jl)
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+      if(ll1(jl,jk) .neqv. ll1(jl,jk+1)) then
+        kknu2(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknu2(jl)=ilevh
+      endif
+ 2005 continue
+ 2004 continue
+      do 2006 jk=klev,ilevh,-1
+      do 2007 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      zhcrit(jl,jk)=amin1(ppic(jl)-pmea(jl),pmea(jl)-pval(jl))
+      zhgeo=pgeom1(jl,jk)/rg
+      ll1(jl,jk)=(zhgeo.gt.zhcrit(jl,jk))
+c     if(ll1(jl,jk).xor.ll1(jl,jk+1)) then
+      if(ll1(jl,jk).neqv.ll1(jl,jk+1)) then
+        kknub(jl)=jk
+      endif
+      if(.not.ll1(jl,ilevh))kknub(jl)=ilevh
+      endif
+ 2007 continue
+ 2006 continue
+c
+      do 2010 jl=kidia,kfdia  
+      if(ktest(jl).eq.1) then
+      kknu(jl)=min(kknu(jl),nktopg)
+      kknu2(jl)=min(kknu2(jl),nktopg)
+      kknub(jl)=min(kknub(jl),nktopg)
+      kknul(jl)=klev
+      endif
+ 2010 continue      
+c
+ 210  continue
+c
+cc*     initialize various arrays
+c
+      do 2107 jl=kidia,kfdia
+      prho(jl,klev+1)  =0.0
+cym correction en attendant mieux
+      prho(jl,1)  =0.0      
+      pstab(jl,klev+1) =0.0
+      pstab(jl,1)      =0.0
+      pri(jl,klev+1)   =9999.0
+      ppsi(jl,klev+1)  =0.0
+      pri(jl,1)        =0.0
+      pvph(jl,1)       =0.0
+      pvph(jl,klev+1)  =0.0
+cym correction en attendant mieux
+cym      pvph(jl,klev)    =0.0
+      pulow(jl)        =0.0
+      pvlow(jl)        =0.0
+      zulow(jl)        =0.0
+      zvlow(jl)        =0.0
+      kkcrith(jl)      =klev
+      kkenvh(jl)       =klev
+      kentp(jl)        =klev
+      kcrit(jl)        =1
+      ncount(jl)       =0
+      ll1(jl,klev+1)   =.false.
+ 2107 continue
+c
+c*     define flow density and stratification (rho and N2)
+c      at semi layers.
+c      -------------------------------------------------------
+c
+      do 223 jk=klev,2,-1
+      do 222 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
+        prho(jl,jk)=2.*paphm1(jl,jk)*zcons1/(ptm1(jl,jk)+ptm1(jl,jk-1))
+      endif
+  222 continue
+  223 continue
+c      print*,"altitude(m)=",pgeom1(kfdia/2,:)
+c      print*,"pression(Pa)=",papm1(kfdia/2,:)
+c
+c********************************************************************
+c
+c*     define Low level flow (between ground and peacks-valleys)
+c      ---------------------------------------------------------
+      do 2115 jk=klev,ilevh,-1
+      do 2116 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+      if(jk.ge.kknu2(jl).and.jk.le.kknul(jl)) then
+        pulow(jl)=pulow(jl)+pum1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pvlow(jl)=pvlow(jl)+pvm1(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        pstab(jl,klev+1)=pstab(jl,klev+1)
+     c                   +pstab(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+        prho(jl,klev+1)=prho(jl,klev+1)
+     c                   +prho(jl,jk)*(paphm1(jl,jk+1)-paphm1(jl,jk))
+      end if
+      endif
+ 2116 continue
+ 2115 continue
+      do 2110 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+      pulow(jl)=pulow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      pvlow(jl)=pvlow(jl)/(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      znorm(jl)=max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+      pvph(jl,klev+1)=znorm(jl)
+      pstab(jl,klev+1)=pstab(jl,klev+1)
+     c                /(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      prho(jl,klev+1)=prho(jl,klev+1)
+     c                /(paphm1(jl,kknul(jl)+1)-paphm1(jl,kknu2(jl)))
+      endif
+ 2110 continue
+
+c
+c*******  setup orography orientation relative to the low level
+C       wind and define parameters of the Anisotropic wave stress.
+c
+      do 2112 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+        lo=(pulow(jl).lt.gvsec).and.(pulow(jl).ge.-gvsec)
+        if(lo) then
+          zu=pulow(jl)+2.*gvsec
+        else
+          zu=pulow(jl)
+        endif
+        zphi=atan(pvlow(jl)/zu)
+        ppsi(jl,klev+1)=ptheta(jl)*rpi/180.-zphi
+        zb(jl)=1.-0.18*pgam(jl)-0.04*pgam(jl)**2
+        zc(jl)=0.48*pgam(jl)+0.3*pgam(jl)**2
+        pd1(jl)=zb(jl)-(zb(jl)-zc(jl))*(sin(ppsi(jl,klev+1))**2)
+        pd2(jl)=(zb(jl)-zc(jl))*sin(ppsi(jl,klev+1))
+     *                         *cos(ppsi(jl,klev+1))
+        pdmod(jl)=sqrt(pd1(jl)**2+pd2(jl)**2)
+      endif
+ 2112 continue
+c
+c  ************ projet flow in plane of lowlevel stress *************
+C  ************ Find critical levels...                 *************
+c
+      do 213 jk=1,klev
+      do 212 jl=kidia,kfdia
+      if(ktest(jl).eq.1)  then
+        zvt1       =pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk)
+        zvt2       =-pvlow(jl)*pum1(jl,jk)+pulow(jl)*pvm1(jl,jk)
+        zvpf(jl,jk)=(zvt1*pd1(jl)+zvt2*pd2(jl))/(znorm(jl)*pdmod(jl))
+      endif
+      ptau(jl,jk)  =0.0
+      pzdep(jl,jk) =0.0
+      ppsi(jl,jk)  =0.0
+      ll1(jl,jk)   =.false.
+  212 continue
+  213 continue
+      do 215 jk=2,klev
+      do 214 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdp(jl,jk)=papm1(jl,jk)-papm1(jl,jk-1)
+        pvph(jl,jk)=((paphm1(jl,jk)-papm1(jl,jk-1))*zvpf(jl,jk)+
+     *            (papm1(jl,jk)-paphm1(jl,jk))*zvpf(jl,jk-1))
+     *            /zdp(jl,jk)
+        if(pvph(jl,jk).lt.gvsec) then
+          pvph(jl,jk)=gvsec
+          kcrit(jl)=jk
+        endif
+      endif
+  214 continue
+  215 continue
+c
+c*         2.3     mean flow richardson number.
+c
+  230 continue
+c
+      do 232 jk=2,klev
+      do 231 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+        zdwind=max(abs(zvpf(jl,jk)-zvpf(jl,jk-1)),gvsec)
+        pri(jl,jk)=pstab(jl,jk)*(zdp(jl,jk)
+     *          /(rg*prho(jl,jk)*zdwind))**2
+        pri(jl,jk)=max(pri(jl,jk),grcrit)
+      endif
+  231 continue
+  232 continue
+  
+c
+c
+c*      define top of 'envelope' layer
+c       ----------------------------
+
+      do 233 jl=kidia,kfdia
+      pnu (jl)=0.0
+      znum(jl)=0.0
+ 233  continue
+      
+      do 234 jk=2,klev-1
+      do 234 jl=kidia,kfdia
+      
+      if(ktest(jl).eq.1) then
+       
+      if (jk.ge.kknu2(jl)) then
+          
+            znum(jl)=pnu(jl)
+            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            zwind=max(sqrt(zwind**2),gvsec)
+            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
+            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
+            zrhom=prho(jl,jk  )
+            zrhop=prho(jl,jk+1)
+            pnu(jl) = pnu(jl) + (zdelp/rg)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
+            if((znum(jl).le.gfrcrit).and.(pnu(jl).gt.gfrcrit)
+     *                          .and.(kkenvh(jl).eq.klev))
+     *      kkenvh(jl)=jk
+     
+      endif    
+
+      endif
+      
+ 234  continue
+      
+c  calculation of a dynamical mixing height for when the waves
+C  BREAK AT LOW LEVEL: The drag will be repartited over
+C  a depths that depends on waves vertical wavelength,
+C  not just between two adjacent model layers.
+c  of gravity waves:
+
+      do 235 jl=kidia,kfdia
+      znup(jl)=0.0
+      znum(jl)=0.0
+ 235  continue
+
+      do 236 jk=klev-1,2,-1
+      do 236 jl=kidia,kfdia
+      
+      if(ktest(jl).eq.1) then
+
+            znum(jl)=znup(jl)
+            zwind=(pulow(jl)*pum1(jl,jk)+pvlow(jl)*pvm1(jl,jk))/
+     *            max(sqrt(pulow(jl)**2+pvlow(jl)**2),gvsec)
+            zwind=max(sqrt(zwind**2),gvsec)
+            zdelp=paphm1(jl,jk+1)-paphm1(jl,jk)
+            zstabm=sqrt(max(pstab(jl,jk  ),gssec))
+            zstabp=sqrt(max(pstab(jl,jk+1),gssec))
+            zrhom=prho(jl,jk  )
+            zrhop=prho(jl,jk+1)
+            znup(jl) = znup(jl) + (zdelp/rg)*
+     *            ((zstabp/zrhop+zstabm/zrhom)/2.)/zwind     
+            if((znum(jl).le.rpi/4.).and.(znup(jl).gt.rpi/4.)
+     *                          .and.(kkcrith(jl).eq.klev))
+     *      kkcrith(jl)=jk
+     
+      endif
+      
+ 236  continue
+ 
+      do 237 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      kkcrith(jl)=max0(kkcrith(jl),ilevh*2)
+      kkcrith(jl)=max0(kkcrith(jl),kknu(jl))
+      if(kcrit(jl).ge.kkcrith(jl))kcrit(jl)=1
+      endif
+ 237  continue         
+c
+c     directional info for flow blocking ************************* 
+c
+      do 251 jk=1,klev    
+      do 252 jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      lo=(pum1(jl,jk).lt.gvsec).and.(pum1(jl,jk).ge.-gvsec)
+      if(lo) then
+        zu=pum1(jl,jk)+2.*gvsec
+      else
+        zu=pum1(jl,jk)
+      endif
+       zphi=atan(pvm1(jl,jk)/zu)
+       ppsi(jl,jk)=ptheta(jl)*rpi/180.-zphi
+      endif
+ 252  continue
+ 251  continue
+
+c      forms the vertical 'leakiness' **************************
+
+      do 254  jk=ilevh,klev
+      do 253  jl=kidia,kfdia
+      if(ktest(jl).eq.1) then
+      pzdep(jl,jk)=0
+      if(jk.ge.kkenvh(jl).and.kkenvh(jl).ne.klev) then
+        pzdep(jl,jk)=(pgeom1(jl,kkenvh(jl)  )-pgeom1(jl,  jk))/
+     *               (pgeom1(jl,kkenvh(jl)  )-pgeom1(jl,klev))
+      end if
+      endif
+ 253  continue
+ 254  continue
+
+      return
+      end
+
+
Index: trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F	(revision 1055)
+++ 	(revision )
@@ -1,385 +1,0 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $
-!
-c
-c
-      SUBROUTINE phyetat0 (fichnom,
-     .            rlat,rlon, tsol,tsoil,
-     .           albe, solsw, sollw,
-     .           fder,radsol,resch4,
-     .           t_ancien,ancien_ok)
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Lecture de l'etat initial pour la physique
-c======================================================================
-      use dimphy
-      use control_mod
-      IMPLICIT none
-#include "dimensions.h"
-#include "netcdf.inc"
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "tabcontrol.h"
-#include "temps.h"
-c======================================================================
-      CHARACTER*(*) fichnom
-      REAL rlat(klon), rlon(klon)   ! in degrees
-      REAL tsol(klon)
-      REAL tsoil(klon,nsoilmx)
-      REAL albe(klon)
-cIM BEG alblw
-      REAL alblw(klon)
-cIM END alblw
-      REAL radsol(klon)
-      REAL sollw(klon)
-      real solsw(klon)
-      real fder(klon)
-
-      REAL t_ancien(klon,klev)
-      LOGICAL ancien_ok
-
-      REAL resch4(klon)
-      INTEGER ig0
-
-      REAL xmin, xmax
-c
-      INTEGER nid, nvarid
-      INTEGER ierr, i, nsrf, isoil 
-      REAL tab_cntrl(length)
-      CHARACTER*2 str2
-c
-c Ouvrir le fichier contenant l'etat initial:
-c
-      print*,'fichnom',fichnom
-      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        write(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-c Lecture des parametres de controle:
-c
-      ierr = NF_INQ_VARID (nid, "controle", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: 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
-         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
-         CALL abort
-      ELSE
-c
-         DO i = 1, length
-           tabcntr0( i ) = tab_cntrl( i )
-         ENDDO
-c
-
-         dtime        = tab_cntrl(1)
-         radpas       = tab_cntrl(2)
-         chimpas      = tab_cntrl(3)
-         lsinit       = tab_cntrl(17)
-
-      ENDIF
-
-      itau_phy = tab_cntrl(15)
-
-c Attention si raz_date est active :
-c il faut remettre a zero itau_phy apres phyetat0
-c et verifier que lsinit est proche de 0.
-      IF (raz_date.eq.1) THEN
-        itau_phy=0
-        if ((lsinit.gt.3.).and.(lsinit.lt.357.)) then
-          PRINT*, 'phyetat0: raz_date=1 and ls different from 0.'
-          PRINT*, 'When raz_date=1, we reset the initial date'
-          PRINT*, 'to spring equinox, Ls=0., so the start files'
-          PRINT*, 'should be within a couple of degrees from Ls=0.'
-          PRINT*, 'or the circulation will be too far from equilibrium'
-          CALL abort
-        endif
-      ENDIF
-
-c
-c Lecture des latitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <latitude> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
-         CALL abort
-      ENDIF
-c
-c Lecture des longitudes (coordonnees):
-c
-      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <longitude> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
-         CALL abort
-      ENDIF
-C
-c Lecture des temperatures du sol:
-c
-      ierr = NF_INQ_VARID (nid, "TS", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <TS> est absent'
-         PRINT*, "phyetat0: Lecture echouee pour <TS>"
-         CALL abort
-      ELSE
-         PRINT*, 'phyetat0: Le champ <TS> est present'
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <TS>"
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         DO i = 1, klon
-            xmin = MIN(tsol(i),xmin)
-            xmax = MAX(tsol(i),xmax)
-         ENDDO
-         PRINT*,'Temperature du sol <TS>', xmin, xmax
-      ENDIF
-c
-c Lecture des temperatures du sol profond:
-c
-      DO isoil=1, nsoilmx
-      IF (isoil.GT.99) THEN
-         PRINT*, "Trop de couches"
-         CALL abort
-      ENDIF
-      WRITE(str2,'(i2.2)') isoil
-      ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
-         PRINT*, "          Il prend donc la valeur de surface"
-         DO i=1, klon
-             tsoil(i,isoil)=tsol(i)
-         ENDDO
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "Lecture echouee pour <Tsoil"//str2//">"
-            CALL abort
-         ENDIF
-      ENDIF
-      ENDDO
-c
-c Lecture de albedo au sol:
-c
-      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
-         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
-         CALL abort
-      ELSE
-         PRINT*, 'phyetat0: Le champ <ALBE> est present'
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1))
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1))
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
-            CALL abort
-         ENDIF
-         xmin = 1.0E+20
-         xmax = -1.0E+20
-         DO i = 1, klon
-            xmin = MIN(albe(i),xmin)
-            xmax = MAX(albe(i),xmax)
-         ENDDO
-         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
-      ENDIF
-
-c
-c Lecture rayonnement solaire au sol:
-c
-      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <solsw> est absent'
-         PRINT*, 'mis a zero'
-         solsw = 0.
-      ELSE
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
-#else
-        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
-#endif
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
-          CALL abort
-        ENDIF
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(solsw(i),xmin)
-         xmax = MAX(solsw(i),xmax)
-      ENDDO
-      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
-c
-c Lecture rayonnement IF au sol:
-c
-      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <sollw> est absent'
-         PRINT*, 'mis a zero'
-         sollw = 0.
-      ELSE
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
-#else
-        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
-#endif
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
-          CALL abort
-        ENDIF
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(sollw(i),xmin)
-         xmax = MAX(sollw(i),xmax)
-      ENDDO
-      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
-
-c
-c Lecture derive des flux:
-c
-      ierr = NF_INQ_VARID (nid, "fder", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <fder> est absent'
-         PRINT*, 'mis a zero'
-         fder = 0.
-      ELSE
-#ifdef NC_DOUBLE
-        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
-#else
-        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
-#endif
-        IF (ierr.NE.NF_NOERR) THEN
-          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
-          CALL abort
-        ENDIF
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(fder(i),xmin)
-         xmax = MAX(fder(i),xmax)
-      ENDDO
-      PRINT*,'Derive des flux fder:', xmin, xmax
-
-c
-c Lecture du rayonnement net au sol:
-c
-      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Le champ <RADS> est absent'
-         CALL abort
-      ENDIF
-#ifdef NC_DOUBLE
-      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
-#else
-      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
-#endif
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
-         CALL abort
-      ENDIF
-      xmin = 1.0E+20
-      xmax = -1.0E+20
-      DO i = 1, klon
-         xmin = MIN(radsol(i),xmin)
-         xmax = MAX(radsol(i),xmax)
-      ENDDO
-      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
-c
-      ancien_ok = .TRUE.
-c
-      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
-         PRINT*, "Depart legerement fausse. Mais je continue"
-         ancien_ok = .FALSE.
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
-            CALL abort
-         ENDIF
-      ENDIF
-c     Par defaut on cree 2 bandes de methane au pole Nord et au pole Sud
-c     (entre 75 et 85 degres de latitude) de 2 metres.
-c     Les poles sont sec !
-      resch4(1) = 0.    ! pole nord = 1 point
-      DO ig0=2,klon
-          if ((rlat(ig0).ge.75..and.rlat(ig0).le.85.).or. 
-     &        (rlat(ig0).ge.-85.and.rlat(ig0).le.-75.)) then
-            resch4(ig0) = 2.
-          else
-            resch4(ig0) = 0.
-          endif
-      ENDDO
-      resch4(klon) = 0.   ! pole sud = 1 point
-
-      ierr = NF_INQ_VARID (nid, "RESCH4", nvarid)
-      IF (ierr.NE.NF_NOERR) THEN
-         PRINT*, "phyetat0: Le champ <RESCH4> est absent"
-         PRINT*, "Pas de reservoir de methane mais je continue..."
-         PRINT*, "Pour info, je met 2 metres de methane sur 2 bandes"
-         PRINT*, "comprises entre 75 et 85 degres de latitude dans  "
-         PRINT*, "chaque hemisphere."
-      ELSE
-#ifdef NC_DOUBLE
-         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, resch4)
-#else
-         ierr = NF_GET_VAR_REAL(nid, nvarid,resch4)
-#endif
-         IF (ierr.NE.NF_NOERR) THEN
-            PRINT*, "phyetat0: Lecture echouee pour <reservoir>"
-            CALL abort
-         ENDIF
-      ENDIF
-c
-c Fermer le fichier:
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
Index: trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/phyetat0.F90	(revision 1056)
@@ -0,0 +1,358 @@
+!
+! $Id $
+!
+subroutine phyetat0(fichnom)
+! Load initial state for the physics
+! and do some resulting initializations
+
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE iophy
+      USE phys_state_var_mod
+      USE iostart
+      USE infotrac
+      USE comgeomphy,  only: rlatd,rlond
+      USE control_mod, only: raz_date
+
+implicit none
+!======================================================================
+! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+! Objet: Lecture de l'etat initial pour la physique
+!======================================================================
+#include "dimensions.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "tabcontrol.h"
+#include "temps.h"
+!======================================================================
+
+character(len=*),intent(in) :: fichnom ! input file name
+REAL    :: xmin, xmax
+LOGICAL :: found
+REAL    :: tab_cntrl(length)
+integer :: i,isoil
+CHARACTER(len=2) :: str2
+
+! les variables globales lues dans le fichier restart
+
+! open physics initial state file:
+call open_startphy(fichnom)
+
+!
+! Lecture des parametres de controle:
+!
+      CALL get_var("controle",tab_cntrl,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <controle> est absent'
+         CALL abort
+      ENDIF
+       
+      DO i = 1, length
+           tabcntr0( i ) = tab_cntrl( i )
+      ENDDO
+
+
+      dtime        = tab_cntrl(1)
+      radpas       = tab_cntrl(2)
+      chimpas      = tab_cntrl(3)
+      lsinit       = tab_cntrl(17)
+
+      itau_phy = tab_cntrl(15)
+
+! Attention si raz_date est active :
+! il faut remettre a zero itau_phy apres phyetat0 !
+! et verifier que lsinit est proche de 0.
+      IF (raz_date.eq.1) THEN
+        itau_phy=0
+        if ((lsinit.gt.3.).and.(lsinit.lt.357.)) then
+          PRINT*, 'phyetat0: raz_date=1 and ls different from 0.'
+          PRINT*, 'When raz_date=1, we reset the initial date'
+          PRINT*, 'to spring equinox, Ls=0., so the start files'
+          PRINT*, 'should be within a couple of degrees from Ls=0.'
+          PRINT*, 'or the circulation will be too far from equilibrium'
+          CALL abort
+        endif
+      ENDIF
+
+! read latitudes
+call get_field("latitude",rlatd,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <latitude> est absent'
+         CALL abort
+      ENDIF
+
+! read longitudes
+call get_field("longitude",rlond,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <longitude> est absent'
+         CALL abort
+      ENDIF
+
+! read in other variables here ...
+
+! Lecture des temperatures du sol:
+
+       CALL get_field("TS",ftsol(:),found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <TS> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <TS>"
+         CALL abort
+      ELSE
+         PRINT*, 'phyetat0: Le champ <TS> est present'
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(ftsol(i),xmin)
+            xmax = MAX(ftsol(i),xmax)
+         ENDDO
+         PRINT*,'Temperature du sol <TS>', xmin, xmax
+      ENDIF
+
+
+! Lecture des temperatures du sol profond:
+
+      DO isoil=1, nsoilmx
+      IF (isoil.GT.99) THEN
+         PRINT*, "Trop de couches"
+         CALL abort
+      ENDIF
+      WRITE(str2,'(i2.2)') isoil
+      CALL get_field('Tsoil'//str2,ftsoil(:,isoil),found)
+      IF (.not.found) THEN
+         PRINT*, "phyetat0: Le champ <Tsoil"//str2//"> est absent"
+         PRINT*, "          Il prend donc la valeur de surface"
+         DO i=1, klon
+             ftsoil(i,isoil)=ftsol(i)
+         ENDDO
+      ENDIF
+      ENDDO
+
+! Lecture de albedo au sol:
+
+      CALL get_field("ALBE", falbe,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
+         PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
+         CALL abort
+      ELSE
+         xmin = 1.0E+20
+         xmax = -1.0E+20
+         DO i = 1, klon
+            xmin = MIN(falbe(i),xmin)
+            xmax = MAX(falbe(i),xmax)
+         ENDDO
+         PRINT*,'Albedo du sol <ALBE>', xmin, xmax
+      ENDIF
+
+! Lecture rayonnement solaire au sol:
+
+      CALL get_field("solsw",solsw,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <solsw> est absent'
+         PRINT*, 'mis a zero'
+         solsw = 0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(solsw(i),xmin)
+         xmax = MAX(solsw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
+
+! Lecture rayonnement IF au sol:
+
+      CALL get_field("sollw",sollw,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <sollw> est absent'
+         PRINT*, 'mis a zero'
+         sollw = 0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(sollw(i),xmin)
+         xmax = MAX(sollw(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
+
+! Lecture derive des flux:
+
+      CALL get_field("fder",fder,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <fder> est absent'
+         PRINT*, 'mis a zero'
+         fder = 0.
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(fder(i),xmin)
+         xmax = MAX(fder(i),xmax)
+      ENDDO
+      PRINT*,'Derive des flux fder:', xmin, xmax
+
+! Lecture du rayonnement net au sol:
+
+      CALL get_field("RADS",radsol,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <RADS> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(radsol(i),xmin)
+         xmax = MAX(radsol(i),xmax)
+      ENDDO
+      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
+
+! Lecture de l'orographie sous-maille si ok_orodr:
+
+      if(ok_orodr) then
+     
+      CALL get_field("ZMEA",zmea,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zmea(i),xmin)
+         xmax = MAX(zmea(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
+
+      CALL get_field("ZSTD",zstd,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zstd(i),xmin)
+         xmax = MAX(zstd(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
+
+      CALL get_field("ZSIG",zsig,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zsig(i),xmin)
+         xmax = MAX(zsig(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
+
+      CALL get_field("ZGAM",zgam,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zgam(i),xmin)
+         xmax = MAX(zgam(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
+
+      CALL get_field("ZTHE",zthe,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zthe(i),xmin)
+         xmax = MAX(zthe(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
+
+      CALL get_field("ZPIC",zpic,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zpic(i),xmin)
+         xmax = MAX(zpic(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
+
+      CALL get_field("ZVAL",zval,found)
+      IF (.not.found) THEN
+         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
+         CALL abort
+      ENDIF
+      xmin = 1.0E+20
+      xmax = -1.0E+20
+      DO i = 1, klon
+         xmin = MIN(zval(i),xmin)
+         xmax = MAX(zval(i),xmax)
+      ENDDO
+      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
+
+      else 
+         zmea = 0.
+         zstd = 0.
+         zsig = 0.
+         zgam = 0.
+         zthe = 0.
+         zpic = 0.
+         zval = 0.
+
+      endif   ! fin test sur ok_orodr
+
+!     Par defaut on cree 2 bandes de methane au pole Nord et au pole Sud
+!     (entre 75 et 85 degres de latitude) de 2 metres.
+!     Les poles sont sec !
+      resch4(1) = 0.    ! pole nord = 1 point
+      DO i=2,klon
+          if ((rlatd(i).ge.75..and.rlatd(i).le.85.).or.  &
+              (rlatd(i).ge.-85.and.rlatd(i).le.-75.)) then
+            resch4(i) = 2.
+          else
+            resch4(i) = 0.
+          endif
+      ENDDO
+      resch4(klon) = 0.   ! pole sud = 1 point
+
+      CALL get_field("RESCH4",resch4,found)
+      IF (.not.found) THEN
+         PRINT*, "phyetat0: Le champ <RESCH4> est absent"
+         PRINT*, "Pas de reservoir de methane mais je continue..."
+         PRINT*, "Pour info, je met 2 metres de methane sur 2 bandes"
+         PRINT*, "comprises entre 75 et 85 degres de latitude dans  "
+         PRINT*, "chaque hemisphere."         
+      ENDIF
+
+! Lecture de TANCIEN:
+
+      ancien_ok = .TRUE.
+
+      CALL get_field("TANCIEN",t_ancien,found)
+      IF (.not.found) THEN
+         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
+         PRINT*, "Depart legerement fausse. Mais je continue"
+         ancien_ok = .FALSE.
+      ENDIF
+
+! close file
+call close_startphy
+
+! do some more initializations
+call init_iophy_new(rlatd,rlond)
+
+end subroutine phyetat0
Index: trunk/LMDZ.TITAN/libf/phytitan/phyredem.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/phyredem.F	(revision 1055)
+++ 	(revision )
@@ -1,273 +1,0 @@
-!
-! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyredem.F,v 1.2 2004/06/22 11:45:34 lmdzadmin Exp $
-!
-c
-      SUBROUTINE phyredem (fichnom,
-     .           rlat,rlon, tsol,tsoil,
-     .           albedo, 
-     .           solsw, sollw,fder,
-     .           radsol,resch4,
-     .           t_ancien)
-
-      USE control_mod
-      use dimphy
-      IMPLICIT none
-c======================================================================
-c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
-c Objet: Ecriture de l'etat de redemarrage pour la physique
-c======================================================================
-#include "dimensions.h"
-#include "netcdf.inc"
-#include "dimsoil.h"
-#include "clesphys.h"
-#include "tabcontrol.h"
-#include "temps.h"
-c======================================================================
-      CHARACTER*13 fichnom
-      REAL rlat(klon), rlon(klon)
-      REAL tsol(klon)
-      REAL tsoil(klon,nsoilmx)
-      REAL albedo(klon)
-      real solsw(klon)
-      real sollw(klon)
-      real fder(klon)
-      REAL radsol(klon)
-      real resch4(klon)
-      REAL t_ancien(klon,klev)
-c
-      INTEGER nid, nvarid, idim1, idim2, idim3
-      INTEGER ierr
-      REAL tab_cntrl(length)
-c
-      INTEGER isoil
-      CHARACTER*2 str2
-c
-c     print*,'fichnom',fichnom
-      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
-      IF (ierr.NE.NF_NOERR) THEN
-        write(6,*)' Pb d''ouverture du fichier '//fichnom
-        write(6,*)' ierr = ', ierr
-        CALL ABORT
-      ENDIF
-c
-      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 28,
-     .                       "Fichier redemarrage physique")
-c
-      ierr = NF_DEF_DIM (nid, "index", length, idim1)
-      ierr = NF_DEF_DIM (nid, "points_physiques", klon, idim2)
-      ierr = NF_DEF_DIM (nid, "horizon_vertical", klon*klev, idim3)
-c
-      ierr = NF_ENDDEF(nid)
-c
-      DO ierr = 1, length
-         tab_cntrl(ierr) = 0.0
-      ENDDO
-      tab_cntrl(1) = dtime
-      tab_cntrl(2) = radpas
-      tab_cntrl(3) = chimpas
-      tab_cntrl(4) = solaire
-      tab_cntrl(5) = 0
-      tab_cntrl(6) = nbapp_rad
-      tab_cntrl(16)= nbapp_chim
-      tab_cntrl(17)= lsinit
-
-      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
-      IF(   soil_model ) tab_cntrl( 8 ) = 1.
-      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
-      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
-      IF( ok_gw_nonoro ) tab_cntrl(12 ) = 1.
-
-      tab_cntrl(13) = day_end
-      tab_cntrl(14) = annee_ref
-      tab_cntrl(15) = itau_phy
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "controle", NF_DOUBLE, 1, idim1,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "controle", NF_FLOAT, 1, idim1,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Parametres de controle")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "longitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "longitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
-     .                        "Longitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlon)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlon)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "latitude", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "latitude", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 31,
-     .                        "Latitudes de la grille physique")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlat)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlat)
-#endif
-c
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "TS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "TS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 22,
-     .                        "Temperature de surface")
-        ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsol(1))
-#else
-        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsol(1))
-#endif
-c
-      DO isoil=1, nsoilmx
-        IF (isoil.LE.99) THEN
-        WRITE(str2,'(i2.2)') isoil
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid, "Tsoil"//str2,NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 24,
-     .                        "Temperature du sol No."//str2)
-        ierr = NF_ENDDEF(nid)
-        ELSE
-        PRINT*, "Trop de couches"
-        CALL abort
-        ENDIF
-#ifdef NC_DOUBLE
-        ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tsoil(1,isoil))
-#else
-        ierr = NF_PUT_VAR_REAL (nid,nvarid,tsoil(1,isoil))
-#endif
-      ENDDO
-c
-        ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-        ierr = NF_DEF_VAR (nid,"ALBE",NF_DOUBLE,1,idim2,nvarid)
-#else
-        ierr = NF_DEF_VAR (nid,"ALBE",NF_FLOAT,1,idim2,nvarid)
-#endif
-        ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 18,
-     .                        "albedo de surface")
-        ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,albedo(1))
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,albedo(1))
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "solsw", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "solsw", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 32,
-     .                        "Rayonnement solaire a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,solsw)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,solsw)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "sollw", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "sollw", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 27,
-     .                        "Rayonnement IF a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,sollw)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,sollw)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "fder", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "fder", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 14,
-     .                        "Derive de flux")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,fder)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,fder)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RADS", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RADS", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
-     .                        "Rayonnement net a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,radsol)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,radsol)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "RESCH4", NF_DOUBLE, 1, idim2,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "RESCH4", NF_FLOAT, 1, idim2,nvarid)
-#endif
-      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 26,
-     .                        "Reservoir CH4 a la surface")
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,resch4)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,resch4)
-#endif
-c
-      ierr = NF_REDEF (nid)
-#ifdef NC_DOUBLE
-      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
-#else
-      ierr = NF_DEF_VAR (nid, "TANCIEN", NF_FLOAT, 1, idim3,nvarid)
-#endif
-      ierr = NF_ENDDEF(nid)
-#ifdef NC_DOUBLE
-      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,t_ancien)
-#else
-      ierr = NF_PUT_VAR_REAL (nid,nvarid,t_ancien)
-#endif
-c
-      ierr = NF_CLOSE(nid)
-c
-      RETURN
-      END
Index: trunk/LMDZ.TITAN/libf/phytitan/phyredem.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/phyredem.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/phyredem.F90	(revision 1056)
@@ -0,0 +1,109 @@
+!
+! $Id: $
+!
+      SUBROUTINE phyredem (fichnom)
+
+      USE dimphy
+      USE mod_grid_phy_lmdz
+      USE mod_phys_lmdz_para
+      USE iophy
+      USE phys_state_var_mod
+      USE iostart, only : open_restartphy,close_restartphy, & 
+                          put_var,put_field
+      USE infotrac
+      USE comgeomphy,  only: rlatd,rlond
+      USE control_mod, only: raz_date
+
+      implicit none
+!======================================================================
+! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
+! Objet: Lecture de l'etat initial pour la physique
+!======================================================================
+#include "dimensions.h"
+#include "netcdf.inc"
+#include "dimsoil.h"
+#include "clesphys.h"
+#include "tabcontrol.h"
+#include "temps.h"
+!======================================================================
+
+character(len=*),intent(in) :: fichnom
+REAL    :: tab_cntrl(length)
+integer :: isoil
+CHARACTER(len=2) :: str2
+
+
+! open file
+
+      CALL open_restartphy(fichnom)
+
+! tab_cntrl() contains run parameters
+
+      tab_cntrl(:)=0.0
+ 
+      tab_cntrl(1) = dtime
+      tab_cntrl(2) = radpas
+      tab_cntrl(3) = chimpas
+      tab_cntrl(4) = solaire
+      tab_cntrl(5) = 0
+      tab_cntrl(6) = nbapp_rad
+      tab_cntrl(16)= nbapp_chim
+      tab_cntrl(17)= lsinit
+
+      IF( cycle_diurne ) tab_cntrl( 7 ) = 1.
+      IF(   soil_model ) tab_cntrl( 8 ) = 1.
+      IF(     ok_orodr ) tab_cntrl(10 ) = 1.
+      IF(     ok_orolf ) tab_cntrl(11 ) = 1.
+      IF( ok_gw_nonoro ) tab_cntrl(12 ) = 1.
+
+      tab_cntrl(13) = day_end
+      tab_cntrl(14) = annee_ref
+      tab_cntrl(15) = itau_phy
+
+      CALL put_var("controle","Parametres de controle",tab_cntrl)
+
+! coordinates
+
+      CALL put_field("longitude", &
+                     "Longitudes de la grille physique",rlond)
+     
+      CALL put_field("latitude","Latitudes de la grille physique",rlatd)
+
+! variables
+
+      CALL put_field("TS","Temperature de surface",ftsol)
+
+      DO isoil=1, nsoilmx
+        IF (isoil.LE.99) THEN
+        WRITE(str2,'(i2.2)') isoil
+        CALL put_field("Tsoil"//str2, &
+                       "Temperature du sol No."//str2,ftsoil(:,isoil))
+        ELSE
+        PRINT*, "Trop de couches"
+        CALL abort
+        ENDIF
+      ENDDO
+
+      CALL put_field("ALBE","albedo de surface",falbe)
+      CALL put_field("solsw","Rayonnement solaire a la surface",solsw)
+      CALL put_field("sollw","Rayonnement IR a la surface",sollw)
+      CALL put_field("fder","Derive de flux",fder)
+      CALL put_field("RADS","Rayonnement net a la surface",radsol)
+      CALL put_field("ZMEA","zmea Orographie sous-maille",zmea)
+      CALL put_field("ZSTD","zstd Orographie sous-maille",zstd)
+      CALL put_field("ZSIG","zsig Orographie sous-maille",zsig)
+      CALL put_field("ZGAM","zgam Orographie sous-maille",zgam)
+      CALL put_field("ZTHE","zthe Orographie sous-maille",zthe)
+      CALL put_field("ZPIC","zpic Orographie sous-maille",zpic)
+      CALL put_field("ZVAL","zval Orographie sous-maille",zval)
+
+      CALL put_field("RESCH4","Reservoir CH4 a la surface",resch4)
+
+      CALL put_field("TANCIEN","T Previous iteration",t_ancien)
+
+! close file
+
+      CALL close_restartphy
+!$OMP BARRIER
+
+      END SUBROUTINE phyredem
Index: trunk/LMDZ.TITAN/libf/phytitan/phys_state_var_mod.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/phys_state_var_mod.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/phys_state_var_mod.F90	(revision 1056)
@@ -0,0 +1,168 @@
+!
+! $Id: phys_state_var_mod.F90 1670 2012-10-17 08:42:04Z idelkadi $
+!
+      MODULE phys_state_var_mod
+! Variables sauvegardees pour le startphy.nc
+!======================================================================
+!
+!
+!======================================================================
+! Declaration des variables
+      USE dimphy
+!      INTEGER, SAVE :: radpas
+!!$OMP THREADPRIVATE(radpas)
+!      REAL, SAVE :: dtime
+!!$OMP THREADPRIVATE(dtime)
+
+      REAL, ALLOCATABLE, SAVE :: ftsol(:)
+!$OMP THREADPRIVATE(ftsol)
+      REAL, ALLOCATABLE, SAVE :: ftsoil(:,:)
+!$OMP THREADPRIVATE(ftsoil)
+      REAL, ALLOCATABLE, SAVE :: falbe(:)
+!$OMP THREADPRIVATE(falbe)
+
+!clesphy0 param physiq
+!
+! Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
+!
+      REAL, ALLOCATABLE, SAVE :: zmea(:), zstd(:), zsig(:), zgam(:)
+!$OMP THREADPRIVATE(zmea, zstd, zsig, zgam)
+      REAL, ALLOCATABLE, SAVE :: zthe(:), zpic(:), zval(:)
+!$OMP THREADPRIVATE(zthe, zpic, zval)
+!     REAL tabcntr0(100)
+      REAL, ALLOCATABLE, SAVE :: rugoro(:)
+!$OMP THREADPRIVATE(rugoro)
+      REAL, ALLOCATABLE, SAVE :: t_ancien(:,:), q_ancien(:,:)
+!$OMP THREADPRIVATE(t_ancien, q_ancien)
+      REAL, ALLOCATABLE, SAVE :: u_ancien(:,:), v_ancien(:,:)
+!$OMP THREADPRIVATE(u_ancien, v_ancien)
+      LOGICAL, SAVE :: ancien_ok
+!$OMP THREADPRIVATE(ancien_ok)
+! pressure level
+      REAL,ALLOCATABLE,SAVE :: zuthe(:),zvthe(:)
+!$OMP THREADPRIVATE(zuthe,zvthe)
+!
+! heat : chauffage solaire
+! heat0: chauffage solaire ciel clair
+! cool : refroidissement infrarouge
+! cool0 : refroidissement infrarouge ciel clair
+! sollwdown : downward LW flux at surface
+! sollwdownclr : downward CS LW flux at surface
+! toplwdown : downward CS LW flux at TOA
+! toplwdownclr : downward CS LW flux at TOA
+      REAL,ALLOCATABLE,SAVE :: swnet(:,:)   
+!$OMP THREADPRIVATE(swnet)
+      REAL,ALLOCATABLE,SAVE :: lwnet(:,:)   
+!$OMP THREADPRIVATE(lwnet)
+      REAL,ALLOCATABLE,SAVE :: heat(:,:)   
+!$OMP THREADPRIVATE(heat)
+      REAL,ALLOCATABLE,SAVE :: heat0(:,:)
+!$OMP THREADPRIVATE(heat0)
+      REAL,ALLOCATABLE,SAVE :: cool(:,:)
+!$OMP THREADPRIVATE(cool)
+      REAL,ALLOCATABLE,SAVE :: cool0(:,:)
+!$OMP THREADPRIVATE(cool0)
+      REAL,ALLOCATABLE,SAVE :: dtrad(:,:)   
+!$OMP THREADPRIVATE(dtrad)
+      REAL,ALLOCATABLE,SAVE :: topsw(:), toplw(:)
+!$OMP THREADPRIVATE(topsw,toplw)
+      REAL, ALLOCATABLE, SAVE :: solsw(:), sollw(:)
+!$OMP THREADPRIVATE(solsw, sollw)
+      REAL, ALLOCATABLE, SAVE :: radsol(:)
+!$OMP THREADPRIVATE(radsol)
+      REAL,ALLOCATABLE,SAVE :: sollwdown(:)
+!$OMP THREADPRIVATE(sollwdown)
+      REAL,ALLOCATABLE,SAVE :: sollwdownclr(:)
+!$OMP THREADPRIVATE(sollwdownclr)
+      REAL,ALLOCATABLE,SAVE :: toplwdown(:)
+!$OMP THREADPRIVATE(toplwdown)
+      REAL,ALLOCATABLE,SAVE :: toplwdownclr(:)
+!$OMP THREADPRIVATE(toplwdownclr)
+      REAL,ALLOCATABLE,SAVE :: topsw0(:),toplw0(:),solsw0(:),sollw0(:)
+!$OMP THREADPRIVATE(topsw0,toplw0,solsw0,sollw0)
+      REAL,save,allocatable :: dlw(:)  ! derivee infra rouge
+      REAL,save,allocatable :: fder(:) ! Derive de flux (sensible et latente) 
+!$OMP THREADPRIVATE(dlw,fder)
+
+!
+! Parametres pour le cycle du methane:
+!
+      REAL,save,allocatable :: resch4(:) ! surface reservoir CH4
+!$OMP THREADPRIVATE(resch4)
+
+CONTAINS
+
+!======================================================================
+SUBROUTINE phys_state_var_init
+use dimphy
+USE control_mod
+IMPLICIT NONE
+#include "dimsoil.h"
+
+      ALLOCATE(ftsol(klon))            ! temperature de surface
+      ALLOCATE(ftsoil(klon,nsoilmx))   ! temperature dans le sol
+      ALLOCATE(falbe(klon))            ! albedo
+
+!  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
+!
+!zmea(:)   ! orographie moyenne
+!zstd(:)   ! deviation standard de l'OESM
+!zsig(:)   ! pente de l'OESM
+!zgam(:)   ! anisotropie de l'OESM
+!zthe(:)   ! orientation de l'OESM
+!zpic(:)   ! Maximum de l'OESM
+!zval(:)   ! Minimum de l'OESM
+!rugoro(:) ! longueur de rugosite de l'OESM
+      ALLOCATE(zmea(klon), zstd(klon), zsig(klon), zgam(klon))
+      ALLOCATE(zthe(klon), zpic(klon), zval(klon))
+      ALLOCATE(rugoro(klon))
+
+      ALLOCATE(t_ancien(klon,klev), q_ancien(klon,klev))
+      ALLOCATE(u_ancien(klon,klev), v_ancien(klon,klev))
+
+      ALLOCATE(zuthe(klon),zvthe(klon))
+!
+      ALLOCATE(swnet(klon,klev+1), lwnet(klon,klev+1)) 
+      ALLOCATE(heat(klon,klev), heat0(klon,klev)) 
+      ALLOCATE(cool(klon,klev), cool0(klon,klev))
+      ALLOCATE(dtrad(klon,klev))
+      ALLOCATE(topsw(klon), toplw(klon))
+      ALLOCATE(solsw(klon), sollw(klon))
+      ALLOCATE(radsol(klon))  ! bilan radiatif au sol calcule par code radiatif
+      ALLOCATE(sollwdown(klon), sollwdownclr(klon))
+      ALLOCATE(toplwdown(klon), toplwdownclr(klon))
+      ALLOCATE(topsw0(klon),toplw0(klon),solsw0(klon),sollw0(klon))
+      ALLOCATE(dlw(klon), fder(klon))
+      
+      ALLOCATE(resch4(klon))
+
+END SUBROUTINE phys_state_var_init
+
+!======================================================================
+SUBROUTINE phys_state_var_end
+use dimphy
+use control_mod
+IMPLICIT NONE
+
+      deallocate(ftsol, ftsoil, falbe)
+      deallocate(zmea, zstd, zsig, zgam)
+      deallocate(zthe, zpic, zval)
+      deallocate(rugoro, t_ancien, q_ancien)
+      deallocate(        u_ancien, v_ancien)
+      deallocate(zuthe, zvthe)
+      deallocate(swnet, lwnet) 
+      deallocate(heat, heat0) 
+      deallocate(cool, cool0)
+      deallocate(dtrad)
+      deallocate(solsw, sollw, radsol)
+      deallocate(topsw, toplw)
+      deallocate(sollwdown, sollwdownclr)
+      deallocate(toplwdown, toplwdownclr)
+      deallocate(topsw0,toplw0,solsw0,sollw0)
+      deallocate(dlw, fder)
+
+      deallocate(resch4)
+
+END SUBROUTINE phys_state_var_end
+
+      END MODULE phys_state_var_mod
Index: trunk/LMDZ.TITAN/libf/phytitan/physiq.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/physiq.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/physiq.F	(revision 1056)
@@ -13,6 +13,5 @@
 c
 c Modifications pour la physique de Titan
-c  adaptation a partir de celle de Venus
-c     S. Lebonnois (LMD/CNRS) Mai 2008
+c     S. Lebonnois (LMD/CNRS) Juin 2013: Parallelisation
 c
 c ---------------------------------------------------------------------
@@ -28,24 +27,24 @@
 c  Arguments:
 c
-c nlon------input-I-nombre de points horizontaux
-c nlev------input-I-nombre de couches verticales
-c nqmax-----input-I-nombre de traceurs
-c debut-----input-L-variable logique indiquant le premier passage
-c lafin-----input-L-variable logique indiquant le dernier passage
-c rjourvrai-input-R-NBjours
-c gmtime----input-R-temps universel dans la journee (fraction de jour)
-c pdtphys---input-R-pas d'integration pour la physique (seconde)
-c paprs-----input-R-pression pour chaque inter-couche (en Pa)
-c pplay-----input-R-pression pour le mileu de chaque couche (en Pa)
-c ppk  -----input-R-fonction d'Exner au milieu de couche
-c pphi------input-R-geopotentiel de chaque couche (g z) (reference sol)
-c pphis-----input-R-geopotentiel du sol
-c presnivs--input_R_pressions approximat. des milieux couches ( en PA)
-c u---------input-R-vitesse dans la direction X (de O a E) en m/s
-c v---------input-R-vitesse Y (de S a N) en m/s
-c t---------input-R-temperature (K)
-c qx--------input-R-mass mixing ratio traceurs (kg/kg) 
-c d_t_dyn---input-R-tendance dynamique pour "t" (K/s)
-c omega-----input-R-vitesse verticale en Pa/s
+c nlon----input-I-nombre de points horizontaux
+c nlev----input-I-nombre de couches verticales
+c nqmax---input-I-nombre de traceurs
+c debut---input-L-variable logique indiquant le premier passage
+c lafin---input-L-variable logique indiquant le dernier passage
+c rjour---input-R-numero du jour de l'experience
+c gmtime--input-R-temps universel dans la journee (0 a RDAY s)
+c pdtphys-input-R-pas d'integration pour la physique (seconde)
+c paprs---input-R-pression pour chaque inter-couche (en Pa)
+c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
+c ppk  ---input-R-fonction d'Exner au milieu de couche
+c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
+c pphis---input-R-geopotentiel du sol
+c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
+c u-------input-R-vitesse dans la direction X (de O a E) en m/s
+c v-------input-R-vitesse Y (de S a N) en m/s
+c t-------input-R-temperature (K)
+c qx------input-R-mass mixing ratio traceurs (kg/kg) 
+c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
+c omega---input-R-vitesse verticale en Pa/s
 c
 c d_u-----output-R-tendance physique de "u" (m/s/s)
@@ -62,10 +61,21 @@
       USE comgeomphy
       use cpdet_mod, only: cpdet, t2tpot
+      USE mod_phys_lmdz_para, only : is_parallel,jj_nb
+      USE phys_state_var_mod ! Variables sauvegardees de la physique
+      USE iophy
+      USE common_mod, only: rmcbar,xfbar,ncount,
+     &      flxesp_i,tau_drop,tau_aer,solesp,precip,
+     &      evapch4,occcld_m,occcld,satch4,satc2h6,satc2h2,rmcloud,
+     &      TauHID,TauHVD,TauGID,TauGVD,TauCID,TauCVD,NSPECV,NSPECI,
+     &      common_init
+
+      USE moyzon_mod
+      USE write_field_phy
       IMPLICIT none
 c======================================================================
 c   CLEFS CPP POUR LES IO
 c   =====================
+#define histday
 #define histmth
-#define histday
 #define histins
 c======================================================================
@@ -78,17 +88,16 @@
 #include "iniprint.h"
 #include "logic.h"
+#include "tabcontrol.h"
 #include "comorbit.h"
 #include "microtab.h"
-#include "diagmuphy.h"
-#include "tabcontrol.h"
 #include "itemps.h"
 c======================================================================
+      LOGICAL ok_journe ! sortir le fichier journalier
+      save ok_journe
+c      PARAMETER (ok_journe=.true.)
+c
       LOGICAL ok_mensuel ! sortir le fichier mensuel
       save ok_mensuel
 c      PARAMETER (ok_mensuel=.true.)
-c
-      LOGICAL ok_journe ! sortir le fichier journalier
-      save ok_journe
-c      PARAMETER (ok_journe=.true.)
 c
       LOGICAL ok_instan ! sortir le fichier instantane
@@ -121,9 +130,4 @@
       REAL qx(klon,klev,nqmax)
 
-      REAL,save,allocatable :: t_ancien(:,:)
-      REAL,save,allocatable :: u_ancien(:,:)
-      LOGICAL ancien_ok
-      SAVE ancien_ok
-
       REAL d_u_dyn(klon,klev)
       REAL d_t_dyn(klon,klev)
@@ -137,30 +141,10 @@
       REAL d_ps(klon)
 
-      REAL,save,allocatable :: swnet(:,:)
-      REAL,save,allocatable :: lwnet(:,:)
-c
 c Variables propres a la physique
 c
-      REAL,save,allocatable :: radsol(:) ! bilan radiatif au sol calcule par code radiatif
       REAL,save,allocatable :: rlev(:,:) ! altitude a chaque niveau (interface inferieure de la couche) 
       INTEGER,save :: itap        ! compteur pour la physique
-      REAL,save,allocatable :: ftsol(:)    ! temperature du sol
-      REAL,save,allocatable :: ftsoil(:,:) ! temperature dans le sol
-      REAL,save,allocatable :: falbe(:)    ! albedo 
       REAL delp(klon,klev)        ! epaisseur d'une couche
       
-CMODDEB FLOTT
-c
-c  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
-c
-      REAL,save,allocatable :: zmea(:)   ! orographie moyenne
-      REAL,save,allocatable :: zstd(:)   ! deviation standard de l'OESM
-      REAL,save,allocatable :: zsig(:)   ! pente de l'OESM
-      REAL,save,allocatable :: zgam(:)   ! anisotropie de l'OESM
-      REAL,save,allocatable :: zthe(:)   ! orientation de l'OESM
-      REAL,save,allocatable :: zpic(:)   ! Maximum de l'OESM
-      REAL,save,allocatable :: zval(:)   ! Minimum de l'OESM
-      REAL,save,allocatable :: rugoro(:) ! longueur de rugosite de l'OESM
-
       INTEGER igwd,idx(klon),itest(klon)
 c
@@ -191,6 +175,4 @@
 
       REAL zustrph(klon),zvstrph(klon) 
-c
-      REAL,save,allocatable :: zuthe(:),zvthe(:)
 
 c Variables locales:
@@ -199,19 +181,17 @@
       REAL cdragm(klon) ! drag coefficient pour vent
 c
-cAA  Pour TRACEURS 
+cAA  Pour  TRACEURS
 cAA
       REAL,save,allocatable :: source(:,:)
       integer nmicro
       save    nmicro
+      character*8 nom
+      REAL qaer(klon,klev,nqmax)
 
       REAL ycoefh(klon,klev)    ! coef d'echange pour phytrac
       REAL yu1(klon)            ! vents dans la premiere couche U
       REAL yv1(klon)            ! vents dans la premiere couche V
-      character*8 nom
-      REAL qaer(klon,klev,nqmax)
 
       REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
-      REAL,save,allocatable :: dlw(:)  ! derivee infra rouge
-      REAL,save,allocatable :: fder(:) ! Derive de flux (sensible et latente) 
       REAL ve(klon) ! integr. verticale du transport meri. de l'energie
       REAL vq(klon) ! integr. verticale du transport meri. de l'eau
@@ -232,5 +212,5 @@
       EXTERNAL radlwsw   ! rayonnements solaire et infrarouge
       EXTERNAL suphec    ! initialiser certaines constantes
-c      EXTERNAL transp    ! transport total de l'eau et de l'energie
+c     EXTERNAL transp    ! transport total de l'eau et de l'energie
       EXTERNAL abort_gcm
       EXTERNAL printflag
@@ -253,14 +233,4 @@
       REAL flux_ec(klon,klev)   ! flux de chaleur Ec
 c
-c Le rayonnement n'est pas calcule tous les pas, il faut donc
-c                      sauvegarder les sorties du rayonnement
-      REAL,save,allocatable :: heat(:,:)    ! chauffage solaire
-      REAL,save,allocatable :: cool(:,:)    ! refroidissement infrarouge
-      REAL,save,allocatable :: dtrad(:,:)   ! K s-1 
-      REAL,save,allocatable :: topsw(:), toplw(:)
-      REAL,save,allocatable :: solsw(:), sollw(:)
-      REAL,save,allocatable :: sollwdown(:) ! downward LW flux at surface
-      REAL tmpout(klon,klev)  ! K s-1 
-
       REAL    dtimerad
       INTEGER itaprad
@@ -268,5 +238,4 @@
       REAL zdtime
 c
-
 c CHIMIE
 
@@ -278,4 +247,5 @@
 
       REAL dist, rmu0(klon), fract(klon), pdecli
+      REAL rmu0bar(klon), fractbar(klon)
       REAL zday
       REAL zls,zlsdeg,zlsm1
@@ -332,15 +302,9 @@
 c
       REAL tr_seri(klon,klev,nqmax)
+      REAL d_tr(klon,klev,nqmax)
 c
 c pour ioipsl
-      INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev)
-      REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
-      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 
-      REAL zx_tmp_2d(iim,jjmp1),zx_tmp_3d(iim,jjmp1,klev)
-      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
-
       INTEGER nid_day, nid_mth, nid_ins
       SAVE nid_day, nid_mth, nid_ins
-c
       INTEGER nhori, nvert, idayref
       REAL zsto, zout, zsto1, zsto2, zero
@@ -348,5 +312,7 @@
       real zjulian
       save zjulian
-
+      REAL tmpout(klon,klev)  ! pour sorties
+
+      CHARACTER*1  str1
       CHARACTER*2  str2
       character*20 modname
@@ -383,6 +349,4 @@
       REAL mangtot            ! moment cinetique total
 
-      CHARACTER*2 str1
-
 c Temporaire avant de trouver mieux :
 c Recuperation des TAU du TR
@@ -390,24 +354,4 @@
       REAL t_tcld(klon,klev),t_kcld(klon,klev)
       REAL t_kcvd(klon,klev)
-c  ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX
-      INTEGER   ngrid
-      PARAMETER (ngrid=(jjm-1)*iim+2)  ! = klon
-      INTEGER NSPECV,NSPECI,NLAYER
-      PARAMETER (NSPECV=24,NSPECI=46,NLAYER=llm)
-      REAL TAUHID(ngrid,NLAYER,NSPECI)
-     &               ,TAUCID(ngrid,NLAYER,NSPECI)
-     &               ,TAUGID(ngrid,NLAYER,NSPECI)
-     &               ,TAUHVD(ngrid,NLAYER,NSPECV)
-     &               ,TAUCVD(ngrid,NLAYER,NSPECV)
-     &               ,TAUGVD(ngrid,NLAYER,NSPECV)
-
-      COMMON /TAUD/   TAUHID,TAUCID,TAUGID,TAUHVD,TAUCVD,TAUGVD
-      COMMON /PLANT/ CSUBP,F0PI
-      REAL CSUBP,F0PI
-
-* common relatifs au nuages
-      real rmcbar(ngrid,NLAYER),xfbar(ngrid,NLAYER,4) 
-      integer ncount(ngrid,NLAYER)
-      COMMON/rnuabar/ncount,rmcbar,xfbar
 
        REAL ch4(klon,jjm+1),dch4(jjm+1)
@@ -427,5 +371,5 @@
 c======================================================================
 c INITIALISATIONS
-c======================================================================
+c================
 
       modname = 'physiq'
@@ -434,4 +378,9 @@
       bilansmc = 0
       ballons  = 0
+! NE FONCTIONNENT PAS ENCORE EN PARALLELE !!!
+      if (is_parallel) then
+        bilansmc = 0
+        ballons  = 0
+      endif
 
       IF (if_ebil.ge.1) THEN
@@ -449,14 +398,5 @@
 c========================
       IF (debut) THEN
-         allocate(t_ancien(klon,klev),u_ancien(klon,klev))
-         allocate(swnet(klon,klevp1),lwnet(klon,klevp1))
-         allocate(radsol(klon),ftsol(klon),falbe(klon))
-         allocate(rlev(klon,klevp1),ftsoil(klon,nsoilmx))
-         allocate(zmea(klon),zstd(klon),zsig(klon),zgam(klon))
-         allocate(zthe(klon),zpic(klon),zval(klon),rugoro(klon))
-         allocate(zuthe(klon),zvthe(klon),dlw(klon),fder(klon))
-         allocate(heat(klon,klev),cool(klon,klev))
-         allocate(dtrad(klon,klev),topsw(klon),toplw(klon))
-         allocate(solsw(klon),sollw(klon),sollwdown(klon))
+         allocate(rlev(klon,klevp1))
          allocate(source(klon,nqmax))
          allocate(reservoir(klon))
@@ -468,26 +408,28 @@
 c appel a la lecture du physiq.def 
 c
-         call conf_phys(ok_mensuel,ok_journe,ok_instan,if_ebil)
-
+         call conf_phys(ok_journe, ok_mensuel,
+     .                  ok_instan,
+     .                  if_ebil)
+
+         call phys_state_var_init
+         call common_init
 c
 c Initialiser les compteurs:
 c
-         itap        = 0
-         itaprad     = 0
+         itap    = 0
+         itaprad = 0
          itapchim    = 0
+
+c init rnuabar
          ncount(:,:) = 0
-
+         rmcbar  = 0.
+         xfbar   = 0.
+         
 c         
 c Lecture startphy.nc :
 c
-c REMETTRE TOUS LES PARAMETRES POUR OROGW...  A FAIRE POUR TITAN
-         CALL phyetat0 ("startphy.nc",
-     .       rlatd,rlond,ftsol,ftsoil,
-     .       falbe, solsw, sollw,
-     .       dlw,radsol,reservoir,
-c     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,
-     .       t_ancien, ancien_ok)
-
-c dtime est defini dans tabcontrol.h et lu dans startphy 
+         CALL phyetat0 ("startphy.nc")
+
+c dtime est defini dans tabcontrol.h et lu dans startphy
 c pdtphys est calcule a partir des nouvelles conditions:
 c Reinitialisation du pas de temps physique quand changement
@@ -508,13 +450,12 @@
          chimpas =   radpas*nbapp_rad/nbapp_chim
 
-         CALL printflag( ok_mensuel,ok_journe, ok_instan )
-
+         CALL printflag( ok_mensuel,ok_journe,ok_instan )
 c
 c Initialiser les pas de temps:
 c
-      dtimerad = dtime*FLOAT(radpas)  ! pas de temps du rayonnement (s)
+      dtimerad = dtime*REAL(radpas)  ! pas de temps du rayonnement (s)
 c      PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
             
-      dtimechim = dtime*FLOAT(chimpas)  ! pas de temps de la chimie (s)
+      dtimechim = dtime*REAL(chimpas)  ! pas de temps de la chimie (s)
 c      PRINT*,'dtimechim,dtime,chimpas',dtimechim,dtime,chimpas
 
@@ -526,18 +467,18 @@
 c---------
 c FLOTT
-c       IF (ok_orodr) THEN
-c         DO i=1,klon
-c         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
-c         ENDDO
-c         CALL SUGWD(klon,klev,paprs,pplay)
-c         DO i=1,klon
-c         zuthe(i)=0.
-c         zvthe(i)=0.
-c         if(zstd(i).gt.10.)then
-c           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
-c           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
-c         endif
-c         ENDDO
-c       ENDIF
+       IF (ok_orodr) THEN
+         DO i=1,klon
+         rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+         ENDDO
+         CALL SUGWD(klon,klev,paprs,pplay)
+         DO i=1,klon
+         zuthe(i)=0.
+         zvthe(i)=0.
+         if(zstd(i).gt.10.)then
+           zuthe(i)=(1.-zgam(i))*cos(zthe(i))
+           zvthe(i)=(1.-zgam(i))*sin(zthe(i))
+         endif
+         ENDDO
+       ENDIF
 
       if (bilansmc.eq.1) then
@@ -566,5 +507,5 @@
 C TRACEURS
 C source dans couche limite
-          source = 0.0 ! pas de source, pour l'instant
+         source = 0.0 ! pas de source, pour l'instant
 C
 c Si microphysique offline, pas besoin d'avoir de traceurs microphysiques
@@ -586,7 +527,7 @@
       print*,"nmicro=",nmicro
 
-c
+c --------------
 c Verifications:
-c
+c --------------
          IF ((nmicro.eq.0).and.(microfi.eq.1)) THEN
            abort_message="MICROPHYSIQUE ONLINE, MAIS NMICRO=0..."
@@ -611,6 +552,21 @@
             call abort_gcm(modname,abort_message,1)
          ENDIF
-c
-         IF (dtime*FLOAT(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
+
+         IF (((moyzon_mu).and.(microfi.ne.1)).or.
+     .       ((.not.moyzon_mu).and.(microfi.eq.1))) THEN
+           abort_message="Microphysic 2D and moyzon_mu not compatible"
+           write(lunout,*) "moyzon_mu=",moyzon_mu
+           write(lunout,*) "microfi=",microfi
+           call abort_gcm(modname,abort_message,1) 
+         ENDIF
+         IF (((moyzon_ch).and.(.not.chimi)).or.
+     .       ((.not.moyzon_ch).and.(chimi))) THEN
+           abort_message="Chemistry and moyzon_ch not compatible"
+           write(lunout,*) "moyzon_ch=",moyzon_ch
+           write(lunout,*) "chimi=",chimi
+           call abort_gcm(modname,abort_message,1) 
+         ENDIF
+
+         IF (dtime*REAL(radpas).GT.(RDAY*0.25).AND.cycle_diurne)
      $    THEN 
            WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
@@ -625,5 +581,5 @@
          ecrit_mth = NINT(RDAY/dtime) *nday  ! tous les nday jours
          IF (ok_mensuel) THEN
-         WRITE(lunout,*)'La frequence de sortie mensuelle est de ',
+         WRITE(lunout,*)'La frequence de sortie mensuelle est de ', 
      .                   ecrit_mth
          ENDIF
@@ -646,12 +602,12 @@
 #ifdef CPP_IOIPSL
 
+#ifdef histday
+#include "ini_histday.h"
+#endif
+
 #ifdef histmth
 #include "ini_histmth.h"
 #endif
 
-#ifdef histday
-#include "ini_histday.h"
-#endif
-
 #ifdef histins
 #include "ini_histins.h"
@@ -670,7 +626,4 @@
       ENDDO
 
-      rmcbar  = 0.
-      xfbar   = 0.
-         
       ENDIF ! debut
 c====================================================================
@@ -719,5 +672,5 @@
 C
       DO i = 1, klon
-          ztsol(i) = ftsol(i) 
+          ztsol(i) = ftsol(i)
       ENDDO
 C
@@ -777,4 +730,7 @@
       ENDDO
 
+c     call WriteField_phy('physiq_pphi',pphi,klev)
+c     call WriteField_phy('physiq_pphis',pphis,1)
+
 c   calcul du geopotentiel aux niveaux intercouches
 c   ponderation des altitudes au niveau des couches en dp/p
@@ -796,5 +752,5 @@
          DO i=1,klon
             z1=(pplay(i,l-1)+paprs(i,l))/(pplay(i,l-1)-paprs(i,l))
-            z2=(paprs(i,l)+pplay(i,l))/(paprs(i,l)-pplay(i,l))
+            z2=(paprs(i,l)  +pplay(i,l))/(paprs(i,l)  -pplay(i,l))
             zzlev(i,l)=(z1*zzlay(i,l-1)+z2*zzlay(i,l))/(z1+z2)
          ENDDO
@@ -804,4 +760,49 @@
       ENDDO
 
+! zonal averages needed
+      if (moyzon_ch.or.moyzon_mu) then
+
+c      zzlaybar(1,:)=(zphibar(1,:)+zphisbar(1))/RG
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+       zzlaybar(1,:)=RG*RA*RA/(RG*RA-(zphibar(1,:)+zphisbar(1)))-RA
+       zzlevbar(1,1)=zphisbar(1)/RG
+       DO l=2,klev
+            z1=(zplaybar(1,l-1)+zplevbar(1,l))/
+     .            (zplevbar(1,l-1)-zplevbar(1,l))
+            z2=(zplevbar(1,l)  +zplaybar(1,l))/
+     .            (zplevbar(1,l)  -zplaybar(1,l))
+            zzlevbar(1,l)=(z1*zzlaybar(1,l-1)+z2*zzlaybar(1,l))/(z1+z2)
+       ENDDO
+       zzlevbar(1,klev+1)=zzlaybar(1,klev)+
+     .            (zzlaybar(1,klev)-zzlevbar(1,klev))
+
+       DO i=2,klon
+        if (rlatd(i).ne.rlatd(i-1)) then
+         DO l=1,klev
+c         zzlaybar(i,l)=(zphibar(i,l)+zphisbar(i))/RG
+c SI ON TIENT COMPTE DE LA VARIATION DE G AVEC L'ALTITUDE:
+          zzlaybar(i,l)=RG*RA*RA/(RG*RA-(zphibar(i,l)+zphisbar(i)))-RA
+         ENDDO
+         zzlevbar(i,1)=zphisbar(i)/RG
+         DO l=2,klev
+            z1=(zplaybar(i,l-1)+zplevbar(i,l))/
+     .            (zplevbar(i,l-1)-zplevbar(i,l))
+            z2=(zplevbar(i,l)  +zplaybar(i,l))/
+     .            (zplevbar(i,l)  -zplaybar(i,l))
+            zzlevbar(i,l)=(z1*zzlaybar(i,l-1)+z2*zzlaybar(i,l))/(z1+z2)
+         ENDDO
+         zzlevbar(i,klev+1)=zzlaybar(i,klev)+
+     .              (zzlaybar(i,klev)-zzlevbar(i,klev))
+        else
+         zzlaybar(i,:)=zzlaybar(i-1,:)
+         zzlevbar(i,:)=zzlevbar(i-1,:)
+        endif
+       ENDDO
+
+      endif  ! moyzon
+
+c     call WriteField_phy('physiq_zphi',zphi,klev)
+c     call WriteField_phy('physiq_zzlay',zzlay,klev)
+c     call WriteField_phy('physiq_zzlev',zzlev,klev+1)
 c- - - - - - - - - - - - - - - -
 c DIAGNOSTIQUE GRILLE VERTICALE
@@ -838,11 +839,7 @@
       ENDDO
 
-
-
-
-c====================================================================
-c ORBITE ET ECLAIREMENT
-c====================================================================
-
+c====================================================================
+c Orbite et eclairement
+c====================================================================
 
 c Pour TITAN:
@@ -856,13 +853,15 @@
 
 c dans zenang, Ls en degres ; dans mucorr, Ls en radians
+      call mucorr(klon,zls,rlatd,rmu0bar,fractbar)
       IF (cycle_diurne) THEN
-        zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
+        zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
         CALL zenang(zlsdeg,gmtime,zdtime,rlatd,rlond,rmu0,fract)
       ELSE
-        call mucorr(klon,zls,rlatd,rmu0,fract)
+        rmu0  = rmu0bar
+        fract = fractbar
       ENDIF
-
-c====================================================================
-c COUCHE LIMITE 
+      
+c====================================================================
+c Appeler la diffusion verticale (programme de couche limite)
 c====================================================================
 
@@ -901,7 +900,6 @@
 c     print*,"sollw avant clmain=",sollw(klon/2)
 
-c  CLMAIN
-
 ! ADAPTATION GCM POUR CP(T)
+
       CALL clmain(dtime,itap,
      e            t_seri,u_seri,v_seri,
@@ -911,5 +909,5 @@
      $            paprs,pplay,ppk,radsol,falbe,
      e            solsw, sollw, sollwdown, fder,
-     e            rlond, rlatd, cuphy, cvphy, 
+     e            rlond, rlatd, cuphy, cvphy,   
      e            debut, lafin,
      s            d_t_vdf,d_u_vdf,d_v_vdf,d_ts,
@@ -940,9 +938,7 @@
       ENDDO
 
-c        print*,"d_t_vdf1=",d_t_vdf(1,:)*dtime
-c        print*,"d_t_vdf2=",d_t_vdf(klon/2,:)*dtime
-c        print*,"d_t_vdf3=",d_t_vdf(klon,:)*dtime
-c        print*,"d_u_vdf=",d_u_vdf(klon/2,:)*dtime
-c        print*,"d_v_vdf=",d_v_vdf(klon/2,:)*dtime
+c     call WriteField_phy('physiq_dtvdf',d_t_vdf,klev)
+c     call WriteField_phy('physiq_duvdf',d_u_vdf,klev)
+c     call WriteField_phy('physiq_dvvdf',d_v_vdf,klev)
 
 C TRACEURS
@@ -950,13 +946,12 @@
       d_tr_vdf = 0.
       if (iflag_trac.eq.1) then
-      DO iq=1, nqmax
-          CALL cltrac(dtime,ycoefh,t_seri,
-     s               tr_seri(1,1,iq), source,
-     e               paprs, pplay, delp,
+         DO iq=1, nqmax
+             CALL cltrac(dtime,ycoefh,t_seri,
+     s               tr_seri(1,1,iq),source,
+     e               paprs, pplay,delp,
      s               d_tr_vdf(1,1,iq))
-
-          tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
-          d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
-      ENDDO
+             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
+             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
+         ENDDO
       endif
 
@@ -976,10 +971,10 @@
 c Incrementer la temperature du sol
 c
-c     print*,'Tsol avant clmain:',ftsol(klon/2)
+c     print*,'Tsol avant clmain:',ftsol(1)
       DO i = 1, klon
          ftsol(i) = ftsol(i) + d_ts(i)
       ENDDO
 c     print*,'DTsol apres clmain:',d_ts(klon/2)
-c     print*,'Tsol apres clmain:',ftsol(klon/2)
+c     print*,'Tsol apres clmain:',ftsol(1)
 
 c Calculer la derive du flux infrarouge
@@ -1040,13 +1035,11 @@
          d_v_ajs(:,:)= d_v_ajs(:,:)/dtime          ! (m/s)/s
       if (iflag_trac.eq.1) then
-         tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
-         d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime          ! /s
+           tr_seri(:,:,:) = tr_seri(:,:,:) + d_tr_ajs(:,:,:)
+           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
       endif
-      
-c        print*,"d_t_ajs1=",d_t_ajs(1,:)*dtime
-c        print*,"d_t_ajs2=",d_t_ajs(klon/2,:)*dtime
-c        print*,"d_t_ajs3=",d_t_ajs(klon,:)*dtime
-c        print*,"d_u_ajs=",d_u_ajs(klon/2,:)*dtime
-c        print*,"d_v_ajs=",d_v_ajs(klon/2,:)*dtime
+
+c     call WriteField_phy('physiq_dtajs',d_t_ajs,klev)
+c     call WriteField_phy('physiq_duajs',d_u_ajs,klev)
+c     call WriteField_phy('physiq_dvajs',d_v_ajs,klev)
 
       endif
@@ -1090,11 +1083,32 @@
 
       if (iflag_trac.eq.1) then
+c        call WriteField_phy('physiq_qaer01',
+c    .                          qaer(:,:,1),klev)
+c        call WriteField_phy('physiq_qaer10',
+c    .                          qaer(:,:,10),klev)
+c        call WriteField_phy('physiq_tr_seri01',
+c    .                          tr_seri(:,:,1),klev)
+c        call WriteField_phy('physiq_tr_seri10',
+c    .                          tr_seri(:,:,10),klev)
+
 c         call begintime(tt0)
+c in phytrac call, mu0 and fract are only used in brume
+c so we need to pass either rmu0 ou rmu0bar depending on
+c moyzon_mu
+       if (moyzon_mu) then
          call phytrac (debut,lafin,
-     .                   nqmax,nmicro,dtime,appel_chim,dtimechim,
-     .                   paprs,pplay,delp,t,rmu0,fract,pdecli,zls,
-     .                   yu1,yv1,zzlev,zzlay,ftsol,
-     .                   tr_seri,qaer,d_tr_mph,d_tr_kim,
-     .                   fclat,reservoir)
+     .                 nqmax,nmicro,dtime,appel_chim,dtimechim,
+     .                 paprs,pplay,delp,t,rmu0bar,fractbar,pdecli,zls,
+     .                 yu1,yv1,zzlev,zzlay,ftsol,
+     .                 tr_seri,qaer,d_tr_mph,d_tr_kim,
+     .                 fclat,reservoir)
+       else
+         call phytrac (debut,lafin,
+     .                 nqmax,nmicro,dtime,appel_chim,dtimechim,
+     .                 paprs,pplay,delp,t,rmu0,fract,pdecli,zls,
+     .                 yu1,yv1,zzlev,zzlay,ftsol,
+     .                 tr_seri,qaer,d_tr_mph,d_tr_kim,
+     .                 fclat,reservoir)
+       endif
 
 c         call endtime(tt0,tt1)
@@ -1112,4 +1126,8 @@
          tr_seri(:,:,1:nmicro) = tr_seri(:,:,1:nmicro)
      .                        + d_tr_mph(:,:,1:nmicro)*dtime
+c        call WriteField_phy('physiq_d_tr_mph01',
+c    .                          d_tr_mph(:,:,1),klev)
+c        call WriteField_phy('physiq_d_tr_mph10',
+c    .                          d_tr_mph(:,:,10),klev)
 	endif
 c       PAS ELEGANT mais je n'ai pas trouve d'autres solutions :
@@ -1195,6 +1213,6 @@
         DO i=1,klon
           DO j=1,klev
-            rmcbar(i,j)=rmcbar(i,j)/MAX(FLOAT(ncount(i,j)),1.)
-            xfbar(i,j,:)=xfbar(i,j,:)/MAX(FLOAT(ncount(i,j)),1.)
+            rmcbar(i,j)=rmcbar(i,j)/MAX(REAL(ncount(i,j)),1.)
+            xfbar(i,j,:)=xfbar(i,j,:)/MAX(REAL(ncount(i,j)),1.)
           ENDDO 
         ENDDO
@@ -1203,11 +1221,9 @@
 c      call begintime(tt0)
       CALL radlwsw
-     e            (dist, rmu0, fract, falbe, zzlev,
+     e            (dist, rmu0, fract, zzlev,
      e             paprs, pplay,ftsol, t_seri, nqmax, nmicro,
-     c             tr_seri, qaer,
-     s             heat,cool,radsol,
-     s             topsw,toplw,solsw,sollw,
-     s             sollwdown,
-     s             lwnet, swnet)
+     c             tr_seri, qaer)
+c     print*,"apres radlwsw"
+
 c      call endtime(tt0,tt1)
 c      ttrad=ttrad+tt1
@@ -1221,7 +1237,4 @@
       ENDIF
 
-c     print*,"radsol apres radlwsw=",radsol(klon/2)
-c     print*,"solsw apres radlwsw=",solsw(klon/2)
-c     print*,"sollw apres radlwsw=",sollw(klon/2)
       itaprad = 0
       DO k = 1, klev
@@ -1230,10 +1243,8 @@
        ENDDO
       ENDDO
-c       print*,"heat (K/s) =",heat(klon/2,:)
-c       print*,"cool (K/s) =",cool(klon/2,:)
-c       print*,"dtrad1 (K/s) =",dtrad(1,:)
-c       print*,"dtrad2 (K/s) =",dtrad(klon/2,:)
-c       print*,"dtrad3 (K/s) =",dtrad(klon,:)
-	    
+
+c     call WriteField_phy('physiq_heat',heat,klev)
+c     call WriteField_phy('physiq_cool',cool,klev)
+
       ENDIF
       itaprad = itaprad + 1
@@ -1261,4 +1272,200 @@
 c
 
+c====================================================================
+c   Calcul  des gravity waves  FLOTT
+c====================================================================
+c
+      if (ok_orodr.or.ok_gw_nonoro) then
+c  CALCUL DE N2
+       do i=1,klon
+        do k=2,klev
+	  ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
+	  zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
+	enddo
+       enddo
+       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
+       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
+       do i=1,klon
+        do k=2,klev
+	  zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
+	  zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
+          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
+          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
+	enddo
+        zn2(i,1) = 1.e-12  ! securite
+       enddo
+
+      endif
+      
+c ----------------------------ORODRAG
+      IF (ok_orodr) THEN
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+c        IF ((zstd(i).gt.10.0)) THEN
+        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS!!!
+        CALL drag_noro(klon,klev,dtime,paprs,pplay,zphi,zn2,
+     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
+     e                   igwd,idx,itest,
+     e                   t_seri, u_seri, v_seri,
+     s                   zulow, zvlow, zustrdr, zvstrdr,
+     s                   d_t_oro, d_u_oro, d_v_oro)
+
+c       print*,"d_u_oro=",d_u_oro(klon/2,:)
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
+           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
+           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
+           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
+c    
+      ELSE
+         d_t_oro = 0.
+         d_u_oro = 0.
+         d_v_oro = 0.
+	 zustrdr = 0.
+	 zvstrdr = 0.
+c
+      ENDIF ! fin de test sur ok_orodr
+c
+c ----------------------------OROLIFT
+      IF (ok_orolf) THEN
+       print*,"ok_orolf NOT IMPLEMENTED !"
+       stop
+c
+c  selection des points pour lesquels le shema est actif:
+        igwd=0
+        DO i=1,klon
+        itest(i)=0
+        IF ((zpic(i)-zmea(i)).GT.100.) THEN
+          itest(i)=1
+          igwd=igwd+1
+          idx(igwd)=i
+        ENDIF
+        ENDDO
+c        igwdim=MAX(1,igwd)
+c
+c A ADAPTER POUR VENUS ET TITAN!!!
+c            CALL lift_noro(klon,klev,dtime,paprs,pplay,
+c     e                   rlatd,zmea,zstd,zpic,zgam,zthe,zpic,zval,
+c     e                   igwd,idx,itest,
+c     e                   t_seri, u_seri, v_seri,
+c     s                   zulow, zvlow, zustrli, zvstrli,
+c     s                   d_t_lif, d_u_lif, d_v_lif               )
+
+c
+c  ajout des tendances
+           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
+           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
+           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
+           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
+           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
+           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
+c
+      ELSE
+         d_t_lif = 0.
+         d_u_lif = 0.
+         d_v_lif = 0.
+         zustrli = 0.
+         zvstrli = 0.
+c
+      ENDIF ! fin de test sur ok_orolf
+
+c ---------------------------- NON-ORO GRAVITY WAVES
+       IF(ok_gw_nonoro) then
+
+        abort_message="Option non developpee pour Titan"
+        call abort_gcm(modname,abort_message,1)
+c A FAIRE POUR TITAN
+c      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
+c     e               t_seri, u_seri, v_seri,
+c     o               zustrhi,zvstrhi,
+c     o               d_t_hin, d_u_hin, d_v_hin)
+
+c  ajout des tendances
+
+c         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
+c         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
+c         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
+c         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
+c         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
+c         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
+
+      ELSE
+         d_t_hin = 0.
+         d_u_hin = 0.
+         d_v_hin = 0.
+         zustrhi = 0.
+         zvstrhi = 0.
+
+      ENDIF ! fin de test sur ok_gw_nonoro
+
+c====================================================================
+c Transport de ballons 
+c====================================================================
+      if (ballons.eq.1) then
+         CALL ballon(30,pdtphys,rjourvrai,gmtime,rlatd,rlond,
+c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
+     C               t,pplay,u,v,zphi)   ! alt above planet average radius
+      endif !ballons
+
+c====================================================================
+c Bilan de mmt angulaire
+c====================================================================
+      if (bilansmc.eq.1) then
+CMODDEB FLOTT
+C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
+C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
+
+      DO i = 1, klon
+        zustrph(i)=0.
+        zvstrph(i)=0.
+        zustrcl(i)=0.
+        zvstrcl(i)=0.
+      ENDDO
+      DO k = 1, klev
+      DO i = 1, klon
+       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
+     c            (paprs(i,k)-paprs(i,k+1))/rg
+      ENDDO
+      ENDDO
+
+      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime,
+     C               ra,rg,romega,
+     C               rlatd,rlond,pphis,
+     C               zustrdr,zustrli,zustrcl,
+     C               zvstrdr,zvstrli,zvstrcl,
+     C               paprs,u,v)
+                     
+CCMODFIN FLOTT
+      endif !bilansmc
+
+c====================================================================
+c====================================================================
+c Calculer le transport de l'eau et de l'energie (diagnostique)
+c
+c  A REVOIR POUR VENUS ET TITAN...
+c
+c     CALL transp (paprs,ftsol,
+c    e                   t_seri, q_seri, u_seri, v_seri, zphi,
+c    s                   ve, vq, ue, uq)
+c
 c====================================================================
 c+jld ec_conser
@@ -1281,5 +1488,4 @@
 c-jld ec_conser
 c====================================================================
-
       IF (if_ebil.ge.1) THEN 
         ztit='after physic'
@@ -1301,183 +1507,4 @@
       END IF 
 C
-c====================================================================
-c   Calcul  des gravity waves  FLOTT
-c====================================================================
-c
-c      if (ok_orodr.or.ok_gw_nonoro) then
-cc  CALCUL DE N2
-c       do i=1,klon
-c        do k=2,klev
-c	  ztlev(i,k)  = (t_seri(i,k)+t_seri(i,k-1))/2.
-c	  zpklev(i,k) = sqrt(ppk(i,k)*ppk(i,k-1))
-c	enddo
-c       enddo
-c       call t2tpot(klon*klev,ztlev, ztetalev,zpklev)
-c       call t2tpot(klon*klev,t_seri,ztetalay,ppk)
-c       do i=1,klon
-c        do k=2,klev
-c	  zdtetalev(i,k) = ztetalay(i,k)-ztetalay(i,k-1)
-c	  zdzlev(i,k)    = (zphi(i,k)-zphi(i,k-1))/RG
-c          zn2(i,k) = RG*zdtetalev(i,k)/(ztetalev(i,k)*zdzlev(i,k))
-c          zn2(i,k) = max(zn2(i,k),1.e-12)  ! securite
-c	enddo
-c       enddo
-c
-c      endif
-c      
-cc ----------------------------ORODRAG
-c      IF (ok_orodr) THEN
-cc
-cc  selection des points pour lesquels le shema est actif:
-c        igwd=0
-c        DO i=1,klon
-c        itest(i)=0
-cc        IF ((zstd(i).gt.10.0)) THEN
-c        IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
-c          itest(i)=1
-c          igwd=igwd+1
-c          idx(igwd)=i
-c        ENDIF
-c        ENDDO
-cc        igwdim=MAX(1,igwd)
-cc
-cc A ADAPTER POUR TITAN !!!
-c        CALL drag_noro(klon,klev,dtime,paprs,pplay,zphi,zn2,
-c     e                   zmea,zstd, zsig, zgam, zthe,zpic,zval,
-c     e                   igwd,idx,itest,
-c     e                   t_seri, u_seri, v_seri,
-c     s                   zulow, zvlow, zustrdr, zvstrdr,
-c     s                   d_t_oro, d_u_oro, d_v_oro)
-c
-cc  ajout des tendances
-c           t_seri(:,:) = t_seri(:,:) + d_t_oro(:,:)
-c           d_t_oro(:,:)= d_t_oro(:,:)/dtime          ! K/s
-c           u_seri(:,:) = u_seri(:,:) + d_u_oro(:,:)
-c           d_u_oro(:,:)= d_u_oro(:,:)/dtime          ! (m/s)/s
-c           v_seri(:,:) = v_seri(:,:) + d_v_oro(:,:)
-c           d_v_oro(:,:)= d_v_oro(:,:)/dtime          ! (m/s)/s
-cc    
-c      ELSE
-c         d_t_oro = 0.
-c         d_u_oro = 0.
-c         d_v_oro = 0.
-c	 zustrdr = 0.
-c	 zvstrdr = 0.
-cc
-c      ENDIF ! fin de test sur ok_orodr
-cc
-cc ----------------------------OROLIFT
-c      IF (ok_orolf) THEN
-cc
-cc  selection des points pour lesquels le shema est actif:
-c        igwd=0
-c        DO i=1,klon
-c        itest(i)=0
-c        IF ((zpic(i)-zmea(i)).GT.100.) THEN
-c          itest(i)=1
-c          igwd=igwd+1
-c          idx(igwd)=i
-c        ENDIF
-c        ENDDO
-cc        igwdim=MAX(1,igwd)
-cc
-cc A ADAPTER POUR VENUS!!!
-cc            CALL lift_noro(klon,klev,dtime,paprs,pplay,
-cc     e                   rlatd,zmea,zstd,zpic,zgam,zthe,zpic,zval,
-cc     e                   igwd,idx,itest,
-cc     e                   t_seri, u_seri, v_seri,
-cc     s                   zulow, zvlow, zustrli, zvstrli,
-cc     s                   d_t_lif, d_u_lif, d_v_lif               )
-c
-cc
-cc  ajout des tendances
-c           t_seri(:,:) = t_seri(:,:) + d_t_lif(:,:)
-c           d_t_lif(:,:)= d_t_lif(:,:)/dtime          ! K/s
-c           u_seri(:,:) = u_seri(:,:) + d_u_lif(:,:)
-c           d_u_lif(:,:)= d_u_lif(:,:)/dtime          ! (m/s)/s
-c           v_seri(:,:) = v_seri(:,:) + d_v_lif(:,:)
-c           d_v_lif(:,:)= d_v_lif(:,:)/dtime          ! (m/s)/s
-cc
-c      ELSE
-c         d_t_lif = 0.
-c         d_u_lif = 0.
-c         d_v_lif = 0.
-c         zustrli = 0.
-c         zvstrli = 0.
-cc
-c      ENDIF ! fin de test sur ok_orolf
-c
-cc ---------------------------- NON-ORO GRAVITY WAVES
-c       IF(ok_gw_nonoro) then
-c
-c      call flott_gwd_ran(klon,klev,dtime,pplay,zn2,
-c     e               t_seri, u_seri, v_seri,
-c     o               zustrhi,zvstrhi,
-c     o               d_t_hin, d_u_hin, d_v_hin)
-c
-cc  ajout des tendances
-c
-c         t_seri(:,:) = t_seri(:,:) + d_t_hin(:,:)
-c         d_t_hin(:,:)= d_t_hin(:,:)/dtime          ! K/s
-c         u_seri(:,:) = u_seri(:,:) + d_u_hin(:,:)
-c         d_u_hin(:,:)= d_u_hin(:,:)/dtime          ! (m/s)/s
-c         v_seri(:,:) = v_seri(:,:) + d_v_hin(:,:)
-c         d_v_hin(:,:)= d_v_hin(:,:)/dtime          ! (m/s)/s
-c
-c      ELSE
-c         d_t_hin = 0.
-c         d_u_hin = 0.
-c         d_v_hin = 0.
-c         zustrhi = 0.
-c         zvstrhi = 0.
-c
-c      ENDIF ! fin de test sur ok_gw_nonoro
-c
-c====================================================================
-c Transport de ballons 
-c====================================================================
-      if (ballons.eq.1) then
-         CALL ballon(30,pdtphys,rjourvrai,gmtime*RDAY,rlatd,rlond,
-c    C               t,pplay,u,v,pphi)   ! alt above surface (smoothed for GCM)
-     C               t,pplay,u,v,zphi)   ! alt above planet average radius
-      endif !ballons
-
-c====================================================================
-c Bilan de mmt angulaire
-c====================================================================
-      if (bilansmc.eq.1) then
-CMODDEB FLOTT
-C  CALCULER LE BILAN DE MOMENT ANGULAIRE (DIAGNOSTIQUE)
-C STRESS NECESSAIRES: COUCHE LIMITE ET TOUTE LA PHYSIQUE
-
-      DO i = 1, klon
-        zustrph(i)=0.
-        zvstrph(i)=0.
-        zustrcl(i)=0.
-        zvstrcl(i)=0.
-      ENDDO
-      DO k = 1, klev
-      DO i = 1, klon
-       zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zustrcl(i)=zustrcl(i)+d_u_vdf(i,k)*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-       zvstrcl(i)=zvstrcl(i)+d_v_vdf(i,k)*
-     c            (paprs(i,k)-paprs(i,k+1))/rg
-      ENDDO
-      ENDDO
-
-      CALL aaam_bud (27,klon,klev,rjourvrai,gmtime*RDAY,
-     C               ra,rg,romega,
-     C               rlatd,rlond,pphis,
-     C               zustrdr,zustrli,zustrcl,
-     C               zvstrdr,zvstrli,zvstrcl,
-     C               paprs,u,v)
-                     
-CCMODFIN FLOTT
-      endif !bilansmc
-
 c=======================================================================
 c   SORTIES
@@ -1493,6 +1520,4 @@
       ENDDO
       ENDDO
-c     print*,"vnatphy=",v(705,:)
-c     print*,"unatphy=",u(705,:)
 c
       DO iq = 1, nqmax
@@ -1507,5 +1532,5 @@
 c Calcul moment cinetique
 c------------------------
-c TEST 
+c TEST...
 c     mangtot = 0.0
 c     DO k = 1, klev
@@ -1513,5 +1538,5 @@
 c       mang(i,k) = RA*cos(rlatd(i)*RPI/180.)
 c    .     *(u_seri(i,k)+RA*cos(rlatd(i)*RPI/180.)*ROMEGA)
-c    .     *airephy(i)*delp(i,k)/RG
+c    .     *airephy(i)*(paprs(i,k)-paprs(i,k+1))/RG
 c       mangtot=mangtot+mang(i,k)
 c     ENDDO
@@ -1536,16 +1561,16 @@
 #ifdef CPP_IOIPSL
 
+#ifdef histday
+#include "write_histday.h"
+#endif
+
 #ifdef histmth
 #include "write_histmth.h"
 #endif
 
-#ifdef histday
-#include "write_histday.h"
-#endif
-
 #ifdef histins
 #include "write_histins.h"
 #endif
-              
+
 #endif
 
@@ -1557,13 +1582,6 @@
          itau_phy = itau_phy + itap
          lsinit   = zlsdeg
-c REMETTRE TOUS LES PARAMETRES POUR OROGW... A FAIRE POUR TITAN
-         CALL phyredem ("restartphy.nc",
-     .      rlatd, rlond, ftsol, ftsoil,
-     .      falbe,
-     .      solsw, sollw,dlw,
-     .      radsol,reservoir,
-c     .      zmea,zstd,zsig,zgam,zthe,zpic,zval,
-     .      t_ancien)
-      
+         CALL phyredem ("restartphy.nc")
+     
 c--------------FLOTT
 CMODEB LOTT
@@ -1591,5 +1609,4 @@
       ENDIF
       
-
       RETURN
       END
Index: trunk/LMDZ.TITAN/libf/phytitan/phytrac.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/phytrac.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/phytrac.F	(revision 1056)
@@ -16,5 +16,5 @@
 c nqmax--------input-I-nombre de traceurs (total)
 c nmicro-------input-I-nombre de traceurs microphysiques !! doivent etre toujours en premiers!!
-c ptimestep----input-R-pas d'integration pour la physique (seconde)
+c ptimestep----input-R-pas d integration pour la physique (seconde)
 c appkim-------input-I-appel a la chimie
 c dtkim--------input-R-pas de temps chimique (seconde)
@@ -40,4 +40,8 @@
       USE infotrac
       use dimphy
+      USE common_mod, only: rmcbar,xfbar,ncount,
+     &      flxesp_i,tau_drop,tau_aer,solesp,precip,
+     &      evapch4,occcld_m,occcld,satch4,satc2h6,satc2h2,rmcloud
+      USE moyzon_mod
       IMPLICIT none
 #include "dimensions.h"
@@ -46,6 +50,6 @@
 #include "microtab.h"
 #include "varmuphy.h"
-#include "diagmuphy.h"
 #include "itemps.h"
+#include "logic.h"
 
 c======================================================================
@@ -72,13 +76,4 @@
       REAL prec(klon,5)
 
-c  ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX
-      INTEGER   ngrid,NLAYER
-      PARAMETER (ngrid=(jjm-1)*iim+2)  ! = klon
-      PARAMETER (NLAYER=llm)           ! = klev
-* common relatifs au nuages
-      real rmcbar(ngrid,NLAYER),xfbar(ngrid,NLAYER,4) 
-      integer ncount(ngrid,NLAYER)
-      COMMON/rnuabar/ncount,rmcbar,xfbar
-
       REAL rcloud(klon,klev,nrad),xfrac(klon,klev,4)
 
@@ -91,14 +86,11 @@
 
 c grandeurs en moyennes zonales
-      REAL zplev(jjm+1,klev+1),zplay(jjm+1,klev),ztsol(jjm+1)
-      REAL zzlev(jjm+1,klev+1),zzlay(jjm+1,klev)
-      REAL ztemp(jjm+1,klev),zmu0(jjm+1),zfract(jjm+1)
+      REAL zplev(klon,klev+1),zplay(klon,klev)
+      REAL zzlev(klon,klev+1),zzlay(klon,klev)
+      REAL ztemp(klon,klev), delpbar(klon,klev)
       real temp_eq(klev),press_eq(klev)
-      REAL zqaer(jjm+1,klev,nqmax)    ! et non nmicro... Permet nmicro=0.
-      REAL zqaer0(jjm+1,klev,nqmax) 
-      REAL zdqmufi(jjm+1,klev,nqmax)
-      REAL ychim(jjm+1,klev,nqmax-nmicro) 
-      REAL zgaz1(jjm+1,klev),zgaz2(jjm+1,klev),zgaz3(jjm+1,klev)
-      REAL zgaz10(jjm+1,klev),zgaz20(jjm+1,klev),zgaz30(jjm+1,klev)
+      REAL qaer0bar(klon,klev,nqmax)   ! et non nmicro... Permet nmicro=0.
+      REAL zdqmufi(klon,klev,nqmax)
+      REAL ychim(klon,klev,nqmax-nmicro) 
 c La saturation n est calculee qu une seule fois: sauvegarde qysat
 c La chimie n est pas calculee tous les pas, il faut donc
@@ -109,8 +101,4 @@
       integer      i,j,k,l,iq,ig0
       
-      REAL zprec(jjm+1,5),zsolesp(jjm+1,klev,3),
-     &     zflxesp_i(jjm+1,klev,3)
-      REAL ztau_drop(jjm+1,klev),ztau_aer(jjm+1,klev,nrad)
-c
 c    indice des esp chimiques utilisees dans la microfi  
       integer icldch4,icldc2h6,icldc2h2
@@ -121,7 +109,4 @@
       REAL tmp,ex,kmin,kmax,dqsq
       REAL dqch4
-c      REAL ch4(jjm+1),ch4b(jjm+1),dch4(jjm+1),ch4c(jjm+1,llm)
-c       integer ich4
-c       common/ch4ind/ich4
 
 c======================================================================
@@ -129,5 +114,5 @@
 
       if (firstcall) then
-       allocate(qysat(klev,nqmax-nmicro),pdyfi(jjm+1,klev,nqmax-nmicro))
+       allocate(qysat(klev,nqmax-nmicro),pdyfi(klon,klev,nqmax-nmicro))
 
 c  -------- Quelques verifications au demarrage sur les tailles des tableaux.
@@ -156,5 +141,5 @@
          ENDIF
 
-      endif
+      endif  ! firstcall
 
 c RAZ des sorties : les moyennes se font directement dans IOIPSL :
@@ -177,84 +162,56 @@
 c   -------------------
 c   Gestion de la temperature et de la pression :
+c   Utilisation des moyennes zonales:
+
 c   soit la chimie est active, soit la microphysique se fait en 2D.
       IF (chimi.or.microfi.eq.1) THEN
- 
-        zplev = 0.0
-        zplay = 0.0
-        zzlev = 0.0
-        zzlay = 0.0
-        ztemp = 0.0
-        zqaer = 0.0
+        zplev(:,:) = zplevbar(:,:)
+        zplay(:,:) = zplaybar(:,:)
+        zzlev(:,:) = zzlevbar(:,:)
+        zzlay(:,:) = zzlaybar(:,:)
+        ztemp(:,:) = ztfibar(:,:)
         ychim = 0.0
-        zmu0  = 0.0
-        zfract= 0.0
-        zgaz1 = 0.0
-        zgaz2 = 0.0
-        zgaz3 = 0.0
-        zprec = 0.0
-        zflxesp_i = 0.0
-        ztau_drop = 0.0 
-        ztau_aer  = 0.0
-        zsolesp   = 0.0
-   
-       do l=1,llm+1
-         zplev(1,l) = pplev(1,l)
-         zzlev(1,l) = pzlev(1,l)
-	 do j=2,jjm
-	    ig0=1+(j-2)*iim
-	    do i=1,iim
-	       zplev(j,l) = zplev(j,l) + pplev(ig0+i,l)/iim
-               zzlev(j,l) = zzlev(j,l) + pzlev(ig0+i,l)/iim
-	    enddo
-	 enddo
-         zplev(jjm+1,l) = pplev(klon,l)
-         zzlev(jjm+1,l) = pzlev(klon,l)
-       enddo
-
-       do l=1,llm
-         ztemp(1,l) = ptemp(1,l)
-         zplay(1,l) = pplay(1,l)
-         zzlay(1,l) = pzlay(1,l)
-	 do j=2,jjm
-	    ig0=1+(j-2)*iim
-	    do i=1,iim
-	       ztemp(j,l) = ztemp(j,l) + ptemp(ig0+i,l)/iim
-	       zplay(j,l) = zplay(j,l) + pplay(ig0+i,l)/iim
-               zzlay(j,l) = zzlay(j,l) + pzlay(ig0+i,l)/iim
-	    enddo
-	 enddo
-         ztemp(jjm+1,l) = ptemp(klon,l)
-         zplay(jjm+1,l) = pplay(klon,l)
-         zzlay(jjm+1,l) = pzlay(klon,l)
-	 temp_eq  = ztemp((jjm+1)/2,:)
-	 press_eq = zplay((jjm+1)/2,:)/100. ! en mbar
-       enddo
-
-      ENDIF   ! chimi or microfi=1
-
-c   -----------------------------
-c   Gestion des variables de la microphysique :
-c
-c   -------------------
-      if (microfi.ge.1) then
-
-c   Traceurs microphysiques: passage en extensif: n/kg --> n/m^2 (2D ou 3D passage obligatoire)
-      DO iq=1,nmicro
-c        print*,tname(iq)
+      ENDIF
+
+c  Si la microphysique est faite en 2D:
+      IF (microfi.eq.1) THEN
         DO l=1,llm
           DO i = 1, klon
-            qaer(i,l,iq) = tr_seri(i,l,iq)*delp(i,l)/RG
+            delpbar(i,l) = zplevbar(i,l) - zplevbar(i,l+1)
           ENDDO
         ENDDO
-      ENDDO 
-c     copie du tableau de traceur :
-      qaer0(:,:,:)=qaer(:,:,:)
-c
+c   Traceurs microphysiques: passage en extensif: n/kg --> n/m^2
+        DO iq=1,nmicro
+         qaer(:,:,iq) = zqfibar(:,:,iq)*delpbar(:,:)/RG
+         qaer0(:,:,iq)= tr_seri(:,:,iq)*delp(:,:)/RG
+         qaer0bar(:,:,iq) = qaer(:,:,iq)
+        ENDDO
+      ENDIF
+
+c  Si la microphysique est faite en 3D:
+      IF (microfi.eq.2) THEN
+        zplev(:,:) = pplev(:,:)
+        zplay(:,:) = pplay(:,:)
+        zzlev(:,:) = pzlev(:,:)
+        zzlay(:,:) = pzlay(:,:)
+        ztemp(:,:) = ptemp(:,:)    
+c   Traceurs microphysiques: passage en extensif: n/kg --> n/m^2
+        DO iq=1,nmicro
+         qaer(:,:,iq) = tr_seri(:,:,iq)*delp(:,:)/RG
+         qaer0(:,:,iq)= tr_seri(:,:,iq)*delp(:,:)/RG
+        ENDDO
+      ENDIF
+
+      do l=1,llm
+	 temp_eq  = tmoy
+	 press_eq = playmoy/100. ! en mbar
+      enddo
+
 c   -------------------
 c    Extraction des gaz pour les nuages
-c
+      IF ((microfi.ge.1).and.(clouds.eq.1)) THEN
+
 c     recuperation des indices des gaz qui nous interesse       
       if (firstcall) then
-        if (clouds.eq.1) then
           icldch4=-1
           icldc2h6=-1
@@ -279,5 +236,4 @@
             STOP
           endif
-        endif    ! clouds=1
       endif      ! firstcall
 
@@ -286,7 +242,5 @@
 c     On le fait ici pour les sortir dans physiq.F sans avoir a surcharger la routine. 
 c     Elles passent ensuite dans un common pour passer dans les I/O.
-c
-c-------------------------------------------
-      IF (clouds.eq.1) THEN
+
         DO l=1,llm
           DO i = 1, klon
@@ -299,97 +253,34 @@
             call c2h2sat(ptemp(i,l),pplay(i,l),tmp)
             satc2h2(i,l) =tr_seri(i,l,icldc2h2)/(tmp*28./26.)
-   
           ENDDO
         ENDDO
 
 c   Copie des gaz (en 3D)  <== UNIQUEMENT SI ON FAIT DES NUAGES
-        gaz1(:,:) = tr_seri(:,:,icldch4)
-        gaz2(:,:) = tr_seri(:,:,icldc2h6)
-        gaz3(:,:) = tr_seri(:,:,icldc2h2)
-
-      ENDIF      ! clouds=1
+        if (moyzon_mu) then
+         gaz1(:,:) = zqfibar(:,:,icldch4)
+         gaz2(:,:) = zqfibar(:,:,icldc2h6)
+         gaz3(:,:) = zqfibar(:,:,icldc2h2)
+        else
+         gaz1(:,:) = tr_seri(:,:,icldch4)
+         gaz2(:,:) = tr_seri(:,:,icldc2h6)
+         gaz3(:,:) = tr_seri(:,:,icldc2h2)
+        endif
         
-      endif      ! microfi.ge.1
-
-c     -------------------
-c     Si microfi = 1 on est en 2D :
-c     conversion des inputs de muphys
-      IF (microfi.eq.1) THEN
-
-         zmu0(1)   = pmu0(1)
-         zfract(1) = pfract(1)
-	 do j=2,jjm
-	    ig0=1+(j-2)*iim
-	    do i=1,iim
-	       zmu0(j)   = zmu0(j)   + pmu0(ig0+i)/iim
-	       zfract(j) = zfract(j) + pfract(ig0+i)/iim
-	    enddo
-	 enddo
-         zmu0(jjm+1)   = pmu0(klon)
-         zfract(jjm+1) = pfract(klon)
-c
-c     traceurs 3D --> 2D
-c 
-      do iq=1,nqmax
-       do l=1,llm
-         zqaer(1,l,iq) = qaer(1,l,iq)
-	 do j=2,jjm
-	    ig0=1+(j-2)*iim
-	    do i=1,iim
-	       zqaer(j,l,iq) = zqaer(j,l,iq) + qaer(ig0+i,l,iq)/iim
-	    enddo
-	 enddo
-         zqaer(jjm+1,l,iq) = qaer(klon,l,iq)
-       enddo
-      enddo
-c       copie du tableau de traceur
-        zqaer0(:,:,:) = zqaer(:,:,:)
-c 
-c      gaz 3D --> 2D    <=== UNIQUEMENT SI ON FAIT DES NUAGES.
-c
-        if (clouds.eq.1) then
-          do l=1,llm
-            zgaz1(1,l) = gaz1(1,l)
-            zgaz2(1,l) = gaz2(1,l)
-            zgaz3(1,l) = gaz3(1,l)
-            do j=2,jjm
-              ig0=1+(j-2)*iim
-              do i=1,iim
-                zgaz1(j,l) = zgaz1(j,l) + gaz1(ig0+i,l)/iim
-                zgaz2(j,l) = zgaz2(j,l) + gaz2(ig0+i,l)/iim
-                zgaz3(j,l) = zgaz3(j,l) + gaz3(ig0+i,l)/iim
-              enddo
-            enddo
-            zgaz1(jjm+1,l) = gaz1(klon,l)
-            zgaz2(jjm+1,l) = gaz2(klon,l)
-            zgaz3(jjm+1,l) = gaz3(klon,l)
-          enddo
- 
-          zgaz10=zgaz1
-          zgaz20=zgaz2
-          zgaz30=zgaz3
-        endif ! clouds=1
-
-      endif   ! microfi=1
+      endif      ! microfi.ge.1 + clouds.eq.1
+c   -------------------
 
 c AUTRES TRACEURS
       
       if (nqmax.gt.nmicro) then
-      do iq=nmicro+1,nqmax
-       do l=1,llm
-         ychim(1,l,iq-nmicro) = tr_seri(1,l,iq)
-	 do j=2,jjm
-	    ig0=1+(j-2)*iim
-	    do i=1,iim
-	       ychim(j,l,iq-nmicro) = ychim(j,l,iq-nmicro) 
-     .                              + tr_seri(ig0+i,l,iq)/iim
-	    enddo
-	 enddo
-         ychim(jjm+1,l,iq-nmicro) = tr_seri(klon,l,iq)
+       do iq=nmicro+1,nqmax
+        if (moyzon_ch) then
+          ychim(:,:,iq-nmicro) = zqfibar(:,:,iq)
+        else
+          ychim(:,:,iq-nmicro) = tr_seri(:,:,iq)
+        endif
+        nomqy(iq-nmicro) = tname(iq)
+c        print*,iq-nmicro,nomqy(iq-nmicro)
        enddo
-       nomqy(iq-nmicro) = tname(iq)
-c       print*,iq-nmicro,nomqy(iq-nmicro)
-      enddo
-      nomqy(nqmax-nmicro+1) = "HV"
+       nomqy(nqmax-nmicro+1) = "HV"
       endif
 
@@ -416,116 +307,26 @@
        IF (MICROFI.eq.0) THEN
 c        PAS DE MICROPHYSIQUE :
-c        On appelle juste rdf pour creer la grille de rayons.
          IF (firstcall) THEN
           print*,'MICROPHYSIQUE OFF-LINE',MICROFI
-           call rdf()
          ENDIF
-c        NOTES : 
-c        L'appel de rdf ne sert a rien ici mis a part pour le TR. Si cet
-c        appel a deja lieu dans le TR inutile de le refaire ici.
-c        Je ne sais pas exactement comment marche les modules en F90
-c        Mais je recopie les valeurs du common/part/ de rdf pour 
-c        les mettre dans un common interne a la microphysique (voir varmuphy.h)
-c        DONC J'AI BESOIN D'AVOIR ACCES A L'ANCIEN COMMON !!!
-c
-       ELSEIF (MICROFI.eq.1) THEN
-c      MICROPHYSIQUE 2D :
-c      Les input/output comportent le prefixe z pour 2D :)
+       ELSE
          zdqmufi = 0.  ! ne sert que pour chimi pour condensation
-         call muphys(jjm+1,
+         call muphys(klon,
      &        zplev,zplay,zzlev,zzlay,
-     &        ztemp,zqaer,zgaz1,zgaz2,zgaz3,
+     &        ztemp,qaer,gaz1,gaz2,gaz3,
      &        nmicro,ptimestep,
-     &        zmu0,zfract,
+     &        pmu0,pfract,
 c -------- sorties diagnostiques
-     &        zflxesp_i,
-     &        ztau_drop,ztau_aer,
-     &        zsolesp,zprec)
-       ELSE
-c      MICROPHYSIQUE 3D :
-c      Les input sont des champs 3D directement !
-         call muphys(klon,
-     &        pplev,pplay,pzlev,pzlay,
-     &        ptemp,qaer,gaz1,gaz2,gaz3,
-     &        nmicro,ptimestep,
-     &        pmu0,pfract,     
-c ------ sorties diagnostiques
      &        flxesp_i,
      &        tau_drop,tau_aer,
      &        solesp,prec)
-c
+
 c    NOTES :
 c    Ici toutes nos sorties sont des champs 3D...(meme les diagnostiques)
 c    On a rien a faire mis a part copier les dq dans les d_tr
-c
+
        ENDIF
 c       call endtime(tt0,tt1)
 c       ttmuphys=ttmuphys+tt1
-
-c-----------------------------------------------------------------------
-c     Mise a jour des sorties de muphys
-c    -------------
-c       En 2D on copie les sorties de muphys de la grille LATxALT
-c       sur la grille complete. 
-       IF (microfi.eq.1) THEN
-c        precipitations
-         DO l=1,5
-           prec(1,l) = zprec(1,l)
-           ig0 = 2
-           DO j=2,jjm
-             DO i = 1, iim
-               prec(ig0,l) = zprec(j,l)
-               ig0 = ig0 + 1
-             ENDDO
-           ENDDO
-           prec(ig0,l) = zprec(jjm+1,l)
-         ENDDO
-c        taux sedimentation
-         DO l=1,llm
-c          taux sed goutte
-           IF (clouds.eq.1) THEN
-             tau_drop(1,l) = ztau_drop(1,l)
-             ig0 = 2
-             DO j=2,jjm
-               DO i = 1, iim
-                 tau_drop(ig0,l) = ztau_drop(j,l)
-                 ig0 = ig0 + 1
-               ENDDO
-             ENDDO
-             tau_drop(ig0,l) = ztau_drop(jjm+1,l)
-           ENDIF
-c          taux sed aer
-           DO iq=1,nrad
-             tau_aer(1,l,iq)  = ztau_aer(1,l,iq)
-             ig0 = 2
-             DO j=2,jjm
-               DO i = 1, iim
-                 tau_aer(ig0,l,iq)  = ztau_aer(j,l,iq)
-                 ig0 = ig0 + 1
-               ENDDO
-             ENDDO
-             tau_aer(ig0,l,iq) = ztau_aer(jjm+1,l,iq)
-           ENDDO
-         ENDDO
-c        flux glace / production glace
-         IF (clouds.eq.1) THEN
-           DO iq=1,3
-             DO l=1,llm
-               flxesp_i(1,l,iq) = zflxesp_i(1,l,iq)
-               solesp(1,l,iq) = zsolesp(1,l,iq)
-               ig0 = 2
-               DO j=2,jjm
-                 DO i = 1, iim
-                   flxesp_i(ig0,l,iq)=zflxesp_i(j,l,iq)
-                   solesp(ig0,l,iq) = zsolesp(j,l,iq)    
-                   ig0 = ig0 + 1
-                 ENDDO
-               ENDDO
-               flxesp_i(ig0,l,iq)=zflxesp_i(jjm+1,l,iq)
-               solesp(ig0,l,iq) = zsolesp(jjm+1,l,iq)
-             ENDDO
-           ENDDO
-         ENDIF
-       ENDIF
        
 c-----------------------------------------------------------------------
@@ -534,57 +335,20 @@
 c
        IF (clouds.eq.1) THEN
-         IF (microfi.eq.1) THEN
-c          On repasse les gaz en 3D si on a fait de la microphysique en 2D
-           DO l=1,llm
-             gaz1(1,l) = zgaz1(1,l)
-             gaz2(1,l) = zgaz2(1,l)
-             gaz3(1,l) = zgaz3(1,l)
-             ig0 = 2
-             DO j=2,jjm
-               DO i = 1, iim
-                 gaz1(ig0,l) = zgaz1(j,l)* gaz1(ig0,l) /zgaz10(j,l)
-                 gaz2(ig0,l) = zgaz2(j,l)* gaz2(ig0,l) /zgaz20(j,l)
-                 gaz3(ig0,l) = zgaz3(j,l)* gaz3(ig0,l) /zgaz30(j,l)
-                 ig0 = ig0 + 1
-               ENDDO
-             ENDDO
-             gaz1(ig0,l) = zgaz1(jjm+1,l)
-             gaz2(ig0,l) = zgaz2(jjm+1,l)
-             gaz3(ig0,l) = zgaz3(jjm+1,l)
-           ENDDO
-         ENDIF
-c        Mise a jour du reservoir de CH4 (ie : seul le CH4 remplit le reservoir)
-         DO i=1,klon
-            reservoir(i) = reservoir(i)+prec(i,1)
-         ENDDO 
-c        Calcul des sources :
-c        ch4=0.
-c        ch4(1) = gaz1(1,1)
-c         do j=2,jjm
-c           ig0=1+(j-2)*iim
-c           do i=1,iim
-c             ch4(j)= ch4(j) + gaz1(ig0+i,1)/iim
-c           enddo
-c         enddo
-c         ch4(jjm+1) = gaz1(ig0,1)
-
-         CALL sources(klon,klev,ptimestep,z0,
+        IF (microfi.eq.1) THEN
+c        On repasse les gaz en 3D si on a fait de la microphysique en 2D
+         gaz1(:,:)=gaz1(:,:)*tr_seri(:,:,icldch4)/zqfibar(:,:,icldch4)
+         gaz2(:,:)=gaz2(:,:)*tr_seri(:,:,icldc2h6)/zqfibar(:,:,icldc2h6)
+         gaz3(:,:)=gaz3(:,:)*tr_seri(:,:,icldc2h2)/zqfibar(:,:,icldc2h2)
+        ENDIF
+c       Mise a jour du reservoir de CH4 (ie : seul le CH4 remplit le reservoir)
+        DO i=1,klon
+          reservoir(i) = reservoir(i)+prec(i,1)
+        ENDDO 
+
+        CALL sources(klon,klev,ptimestep,z0,
      &                pu,pv,pplev,pzlay,pzlev,
      &                gaz1,gaz2,gaz3,
      &                ftsol,evapch4,reservoir) 
  
-c        ch4b=0.
-c        ch4b(1) = gaz1(1,1)
-c         do j=2,jjm
-c           ig0=1+(j-2)*iim
-c           do i=1,iim
-c             ch4b(j)= ch4b(j) + gaz1(ig0+i,1)/iim
-c           enddo
-c         enddo
-c         ch4b(jjm+1) = gaz1(ig0,1)
-c         do j=1,jjm+1
-c           write(499,*) j,ch4(j),ch4b(j)
-c         enddo
-c         write(499,*) ""
        ENDIF
 c-----------------------------------------------------------------------
@@ -599,5 +363,5 @@
         do iq=1,nqmax-nmicro
            do l=1,llm
-              do j=1,jjm+1
+              do j=1,klon
                  if (ychim(j,l,iq).gt.qysat(l,iq)) then
            zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+qysat(l,iq)) !delta y
@@ -622,5 +386,5 @@
 c         if (nomqy(iq).eq."CH4") then
 c          do l=1,llm
-c             do j=1,jjm+1
+c             do j=1,klon
 c                if (ychim(j,l,iq).le.0.015) then
 c          zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+0.015) !delta y
@@ -640,5 +404,5 @@
 c         if (nomqy(iq).eq."C2H2") then
 c          do l=1,llm
-c             do j=1,jjm+1
+c             do j=1,klon
 c                if (ychim(j,l,iq).gt.1.e-5) then
 c          zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+1.e-5) !delta y
@@ -650,5 +414,5 @@
 c         if (nomqy(iq).eq."C2H6") then
 c          do l=1,llm
-c             do j=1,jjm+1
+c             do j=1,klon
 c                if (ychim(j,l,iq).gt.3.e-5) then
 c          zdqmufi(j,l,nmicro+iq)= (-ychim(j,l,iq)+3.e-5) !delta y
@@ -680,5 +444,5 @@
 c Appel Chimie
 c ------------
-       CALL calchim(nqmax-nmicro,ychim,nomqy,pdecli,lonsol,dtkim,
+       CALL calchim(klon,nqmax-nmicro,ychim,nomqy,pdecli,lonsol,dtkim,
      .              ztemp,zplay,zplev,
      .              pdyfi)   
@@ -701,11 +465,14 @@
 c ---> microphysique 2D
       IF (microfi.eq.1) THEN
-c  on repasse le champ de traceurs en 3D (pas les tendances)
          DO iq=1,nmicro
            DO l=1,llm
-             qaer(1,l,iq) = zqaer(1,l,iq)
-             ig0          = 2
-             DO j=2,jjm
-               DO i = 1, iim
+             DO i=1,klon
+c  on repasse le champ de traceurs en 3D (pas les tendances)
+c qaer est ce qui entre dans muphy, donc la moyenne zonale
+c qaer0 est la valeur initiale du champ
+c qaer0 est la moyenne zonale initiale
+c la variation relative pour une bande de latitude est donc (qaer/qaer0bar)
+c la nouvelle valeur en un point (3D) est donc qaer0*(qaer/qaer0bar)
+c et la tendance: qaer0*(qaer/qaer0bar)-qaer0
 c    un petit patch : 
 c    Si la moyenne zonale au depart est "nulle" :
@@ -714,20 +481,9 @@
 c    Cela permet aussi entre autre d eviter les NaN pour les traceurs des nuages !
 c    (au dessus de la tropo pas de nuages donc qaer(nrad+1:ntype*nrad) = 0 !!!)
-                 IF (zqaer0(j,l,iq).lt.1e-100) THEN
-                   qaer(ig0,l,iq) = zqaer(j,l,iq) 
-                 ELSE
-                   qaer(ig0,l,iq) = zqaer(j,l,iq) *
-     &             qaer0(ig0,l,iq)/zqaer0(j,l,iq)
-                 ENDIF
-                 ig0 = ig0 + 1
-               ENDDO
-             ENDDO
-             qaer(ig0,l,iq) = zqaer(jjm+1,l,iq)
-           ENDDO
-         ENDDO
-c        La tendances correspond a (qaer-qaer0)/ptimestep
-         DO iq=1,nmicro
-           DO i=1,klon
-             DO l=1,llm
+               IF (qaer0bar(i,l,iq).gt.1e-100) THEN
+                   qaer(i,l,iq) = qaer0(i,l,iq) *
+     &             qaer(i,l,iq)/qaer0bar(i,l,iq)
+               ENDIF
+c        La tendance correspond a (qaer-qaer0)/ptimestep
                d_tr_mph(i,l,iq) = (qaer(i,l,iq)-qaer0(i,l,iq))/
      &                            ptimestep
@@ -738,20 +494,11 @@
        ELSEIF(microfi.gt.1) THEN 
          DO iq=1,nmicro
-           DO l=1,llm
-             DO i = 1, klon
-               d_tr_mph(i,l,iq)=(qaer(i,l,iq)-qaer0(i,l,iq))/ptimestep
-             ENDDO
-           ENDDO
+           d_tr_mph(:,:,iq)=(qaer(:,:,iq)-qaer0(:,:,iq))/ptimestep
          ENDDO
-
        ENDIF   ! microfi
 
        DO iq=1,nmicro
-         DO l=1,llm
-           DO i = 1, klon
 c  Traceurs microphysiques: passage en intensif: n/m^2 --> n/kg
-             d_tr_mph(i,l,iq) = d_tr_mph(i,l,iq)*RG/delp(i,l)
-           ENDDO
-         ENDDO
+         d_tr_mph(:,:,iq) = d_tr_mph(:,:,iq)*RG/delp(:,:)
        ENDDO
 
@@ -764,20 +511,8 @@
 
       DO iq=nmicro+1,nqmax
-         DO l=1,llm
-            d_tr_kim(1,l,iq) = pdyfi(1,l,iq-nmicro)
-            d_tr_mph(1,l,iq) = zdqmufi(1,l,iq)
-            ig0          = 2
-            DO j=2,jjm
-               DO i = 1, iim
-                  d_tr_kim(ig0,l,iq)  = pdyfi(j,l,iq-nmicro)
-     &                 *tr_seri(ig0,l,iq)/ychim(j,l,iq-nmicro)
-                  d_tr_mph(ig0,l,iq)  = zdqmufi(j,l,iq)
-     &                 *tr_seri(ig0,l,iq)/ychim(j,l,iq-nmicro)
-                  ig0             = ig0 + 1
-               ENDDO
-            ENDDO
-            d_tr_kim(ig0,l,iq) = pdyfi(jjm+1,l,iq-nmicro)
-            d_tr_mph(ig0,l,iq) = zdqmufi(jjm+1,l,iq)
-         ENDDO
+         d_tr_kim(:,:,iq) = pdyfi(:,:,iq-nmicro)
+     &             *tr_seri(:,:,iq)/ychim(:,:,iq-nmicro)
+         d_tr_mph(:,:,iq) = zdqmufi(:,:,iq)
+     &             *tr_seri(:,:,iq)/ychim(:,:,iq-nmicro)
       ENDDO
 
@@ -792,34 +527,14 @@
 c les especes concernees (CH4, C2H6 pour le moment). 
        IF (microfi.ge.1.and.clouds.eq.1) THEN
-         DO i=1,klon
-           DO l=1,klev
 c     condensation CH4
-             d_tr_mph(i,l,icldch4)=(gaz1(i,l)-tr_seri(i,l,icldch4))
+          d_tr_mph(:,:,icldch4) =(gaz1(:,:)-tr_seri(:,:,icldch4))
      &                            /ptimestep
 c     condensation C2H6
-             d_tr_mph(i,l,icldc2h6)=(gaz2(i,l)-tr_seri(i,l,icldc2h6))
-     &                             /ptimestep
+          d_tr_mph(:,:,icldc2h6)=(gaz2(:,:)-tr_seri(:,:,icldc2h6))
+     &                            /ptimestep
 c     condensation C2H2
-             d_tr_mph(i,l,icldc2h2)=(gaz3(i,l)-tr_seri(i,l,icldc2h2))
-     &                             /ptimestep
-           ENDDO 
-         ENDDO
+          d_tr_mph(:,:,icldc2h2)=(gaz3(:,:)-tr_seri(:,:,icldc2h2))
+     &                            /ptimestep
        ENDIF
-c        ch4c=0.
-c       do l=1,llm
-c       ch4c(1,l) = tr_seri(1,l,icldch4)
-c       do j=2,jjm
-c         ig0=1+(j-2)*iim
-c         do i=1,iim
-c            ch4c(j,l)= ch4c(j,l)+tr_seri(ig0+i,l,icldch4)/iim
-c         enddo
-c       enddo
-c        ch4c(jjm+1,l) = tr_seri(klon,l,icldch4)
-c      enddo
-c       do l=1,llm
-c         write(500,*) pplay(25,l),ch4c(25,l)
-c       enddo
-c       write(500,*) ""
-
 
 c--------------------------------------------------
@@ -882,7 +597,7 @@
            DO j=1,klev 
              DO iq=1,nrad
-*      Rayon minimum selon la quantité de noyaux
-               IF (qaer(i,j,iq+nrad) .le.   1.e-5) THEN
-                  rcloud(i,j,iq) = 1.e-10
+*      Rayon minimum selon la quantite de noyaux
+               IF (qaer(i,j,iq+nrad) .le. 1.e-5) THEN
+                 rcloud(i,j,iq) = 1.e-10
                ELSE
                  rcloud(i,j,iq)=
@@ -940,6 +655,6 @@
 c
 c      OCCCLD
-c      Calcul le nombre d'occurence d'un nuage 
-c      d opacité comprise en kmin et kmax
+c      Calcul le nombre d occurence d un nuage 
+c      d opacite comprise en kmin et kmax
 c          k        kmin            kmax
 c          1   0.0000000      0.10000000    
Index: trunk/LMDZ.TITAN/libf/phytitan/radlwsw.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/radlwsw.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/radlwsw.F	(revision 1056)
@@ -1,9 +1,4 @@
-      SUBROUTINE radlwsw(dist, rmu0, fract, falbe, zzlev,
-     .                  paprs, pplay,tsol, pt, nq, nmicro, pq,
-     .                  qaer,
-     .                  heat,cool,radsol,
-     .                  topsw,toplw,solsw,sollw,
-     .                  sollwdown,
-     .                  lwnet, swnet)
+      SUBROUTINE radlwsw(dist, rmu0, fract, zzlev,
+     .                  paprs, pplay,tsol, pt, nq, nmicro, pq,qaer)
 c      
 c======================================================================
@@ -41,5 +36,8 @@
       use dimphy
       USE comgeomphy
-      IMPLICIT none
+      USE phys_state_var_mod, only: falbe,heat,cool,radsol,
+     .      topsw,toplw,solsw,sollw,sollwdown,lwnet,swnet
+      USE write_field_phy
+       IMPLICIT none
 #include "dimensions.h"
 #include "YOMCST.h"
@@ -48,5 +46,5 @@
 c ARGUMENTS
       INTEGER nq,nmicro
-      real rmu0(klon), fract(klon), falbe(klon), dist
+      real rmu0(klon), fract(klon), dist
 c
       real zzlev(klon,klev+1),paprs(klon,klev+1), pplay(klon,klev)
@@ -55,9 +53,4 @@
       real pq(klon,klev,nq)
       REAL qaer(klon,klev,nq)
-      real heat(klon,klev), cool(klon,klev)
-      real radsol(klon), topsw(klon), toplw(klon)
-      real solsw(klon), sollw(klon)
-      real sollwdown(klon)
-      REAL swnet(klon,klev+1),lwnet(klon,klev+1)
 c
 c LOCAL VARIABLES
@@ -87,4 +80,7 @@
              enddo
 
+c     call WriteField_phy('radlwsw_zp',zp,klev+1)
+
+c =======================================
 c   altitudes (m) avec indice 1 en haut
              do l=1,klev+1
@@ -121,5 +117,4 @@
          CALL radtitan(zp,nq,nmicro,zq,qaer)
 
-c =======================================
 c CALCUL DU SW 
 c =======================================
Index: trunk/LMDZ.TITAN/libf/phytitan/radtitan.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/radtitan.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/radtitan.F	(revision 1056)
@@ -35,4 +35,5 @@
       USE comgeomphy
       USE optcld, only : iniqcld
+      use moyzon_mod, only:plevmoy
       IMPLICIT NONE
 #include "dimensions.h"
@@ -118,5 +119,4 @@
       IPRINT=1
 
-C MODIFY ADJUSTABLE NUMBERS HERE -- NOT IN COMMON
 C&&
       FHAZE=0.3
@@ -124,17 +124,7 @@
        if(iprem.eq.0) then
          TAUFAC=0
-         FHVIS=2.0
-         FHIR=.2
-       print*,'ouverture du fichier initpar'
-       open (unit=1,file='initpar')
-       read(1,*) xpoub,kkk,xvis,xir
-       close(1)
-         FHVIS= xvis
-         FHIR = xir
-       print*,'ouverture du fichier initpar ok'
-       print*,'DANS RADTITAN'
-       print*,'-------------'
-       print*,'FHVIS  = ',FHVIS
-       print*,'FHIR   = ',FHIR
+c xvis et xir lus dans physiq.def  (ancien fichier initpar)
+       FHVIS= xvis
+       FHIR = xir
 c      on initialise le paquet optcld
        if (clouds.eq.1) call iniqcld()
@@ -151,7 +141,11 @@
        print*,notfirstcall
 
-      DO 210 J=1,NLEVEL
-         PRESS(J)=SSUM(klon,p(1,j),1)/FLOAT(klon)
+c   pression moyenne globale
+c   passage au pressions en bar avec indice 1 au sommet.
+c   (similaire zp dans radlwsw)
+      DO 210 J=2,NLEVEL
+         PRESS(J)=plevmoy(NLEVEL+1-j)*1.e-5
 210   CONTINUE
+      PRESS(1) = PRESS(2)*0.001
 
 c  a cause du tableau predefini dans lell.F (et lell_light.F)
Index: trunk/LMDZ.TITAN/libf/phytitan/rcm1d.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/rcm1d.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/rcm1d.F	(revision 1056)
@@ -85,4 +85,5 @@
       COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus
       REAL cppdyn,nu_venus,t0_venus
+      real pi
 
 c=======================================================================
@@ -175,4 +176,5 @@
       ndt=ndt*day_step     
       dtphys=daysec/day_step  
+      dtime=dtphys
 
 c Pression de surface sur la planete
Index: trunk/LMDZ.TITAN/libf/phytitan/readstart.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/readstart.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/readstart.F	(revision 1056)
@@ -0,0 +1,497 @@
+!
+! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/dynetat0.F,v 1.2 2004/06/22 11:45:30 lmdzadmin Exp $
+!
+      SUBROUTINE readstart(fichnom,nq,vcov,ucov,
+     .                    teta,q,masse,ps,phis,tab_cntrl)
+
+      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 "description.h"
+#include "serre.h"
+#include "logic.h"
+#include "netcdf.inc"
+
+c   Arguments:
+c   ----------
+
+      CHARACTER*(*) fichnom
+      INTEGER nq
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+      REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
+      REAL ps(ip1jmp1),phis(ip1jmp1)
+      REAL time
+      INTEGER length
+      PARAMETER (length=100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+
+c   Variables 
+c
+      INTEGER iq,i,j,ij,l
+      INTEGER ierr, nid, nvarid
+
+c   local, cas particulier compo.dat
+      integer nyread
+      real    qy(jjp1,llm,nq)
+      character*10 nomy(nq)
+
+c-----------------------------------------------------------------------
+
+c  Ouverture NetCDF du fichier etat initial
+
+      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
+      IF (ierr.NE.NF_NOERR) THEN
+        write(6,*)' Pb d''ouverture du fichier start.nc'
+        write(6,*)' ierr = ', ierr
+        CALL ABORT
+      ENDIF
+
+c
+      ierr = NF_INQ_VARID (nid, "controle", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "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)
+      start_time = tab_cntrl(32)
+c   .................................................................
+c
+c
+      PRINT*,'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
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour rlatv"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "nivsigs", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <nivsigs> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, nivsigs)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, nivsigs)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <nivsigs>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "nivsig", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <nivsig> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, nivsig)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, nivsig)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <nivsig>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ap", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <ap> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ap)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, ap)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <ap>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "bp", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <bp> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, bp)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, bp)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <bp>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "presnivs", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Le champ <presnivs> est absent"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, presnivs)
+#else
+      ierr = NF_GET_VAR_REAL(nid, nvarid, presnivs)
+#endif
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "dynetat0: Lecture echouee pour <presnivs>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "cu", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <cu>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "cv", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <cv>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "aire", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <aire>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "temps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee <temps>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
+         CALL abort
+      ENDIF
+ 
+      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "teta", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <teta>"
+         CALL abort
+      ENDIF
+
+c TNAME: IL EST LU A PARTIR DE traceur.def (mettre l'ancien si
+c                changement du nombre de traceurs)
+
+      IF((nq.GE.1).and.(iflag_trac.eq.1)) THEN
+      DO iq=1,nq
+        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+            PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
+            PRINT*, "          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
+             PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
+             CALL abort
+          ENDIF
+        ENDIF
+      ENDDO
+      ENDIF
+
+c--------------------------------------------
+c cas particulier: lecture des traceurs 2D dans compo.dat (issu de start 2d)
+c 
+      if (1.eq.0) then
+      OPEN(10,file='compo.dat',status='old',form='formatted',
+     . iostat=ierr)
+      IF (ierr.ne.0) THEN
+       WRITE(6,*)' Pb d''ouverture du fichier de demarrage (compo.dat)'
+       WRITE(6,*)' ierr = ', ierr
+       CALL exit(1)
+      ENDIF
+      READ(10,*) nyread
+      print*,"nombre de composes chimiques ajoutes:",nyread
+      READ(10,*) (((qy(ij,l,iq),ij=1,jjp1),l=1,llm),
+     s                   iq=1,nyread)
+      do iq=1,nyread
+         READ(10,'(1X,A10)') nomy(iq)
+         print*,nomy(iq)," = ", tname(iq+10)
+         do i=1,iip1
+          do j=1,jjp1
+           ij = (j-1)*iip1+i
+           q(ij,:,iq+10) = qy(j,:,iq)
+          enddo
+         enddo
+      enddo
+      CLOSE(10)
+      endif
+c--------------------------------------------
+
+      ierr = NF_INQ_VARID (nid, "masse", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "dynetat0: Lecture echouee pour <masse>"
+         CALL abort
+      ENDIF
+
+      ierr = NF_INQ_VARID (nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "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
+         PRINT*, "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: trunk/LMDZ.TITAN/libf/phytitan/scal_wind.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/scal_wind.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/scal_wind.F	(revision 1056)
@@ -0,0 +1,55 @@
+      SUBROUTINE scal_wind(xus,xvs,xu,xv)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c On passe  les variable xus, xvs  aux points de vent u et v (xu et xv)
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL xu(iip1,jjp1,llm),xv(iip1,jjm,llm)
+      REAL xus(iip1,jjp1,llm), xvs (iip1,jjp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER i,j,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+        Do j=1,jjp1
+	      DO i=1,iim
+            xu(i,j,l)=0.5*(xus(i,j,l)+xus(i+1,j,l))
+	      ENDDO
+          xu(iip1,j,l)=xu(1,j,l)
+	    ENDDO
+      ENDDO
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO j=1,jjm
+           do i=1 ,iip1
+	         xv(i,j,l)=.5*(xvs(i,j,l)+xvs(i,j+1,l))
+           end do
+	     ENDDO
+	  ENDDO
+
+      RETURN
+      END
Index: trunk/LMDZ.TITAN/libf/phytitan/snuages3D.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/snuages3D.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/snuages3D.F	(revision 1056)
@@ -923,9 +923,10 @@
          real rfg(nz),dfg(nz,nrad)
          real puit(nz)
-c ------ echange est decrit sur ngrid=klon mais peut etre utilisee 
-c        uniquement sur jjm+1
+c ------ echange est cree sur la taille maxi mais n'est utilisee
+c        que sur la dim geree par le proc (klon ou jjm+1)
          integer ngrid
-         parameter (ngrid=(jjm-1)*iim+2)  ! = klon
+         parameter (ngrid=(jjm-1)*iim+2)  ! = taille maximum
          real echange(nz,nz,ngrid)
+c pas genial mais vu que c est tres local, pas de soucis a priori en parallele.
          real bilan1,bilan2,bilan3,bilan4,bilan5
          real bilan11,bilan12,bilan13,bilan14,bilan15
Index: trunk/LMDZ.TITAN/libf/phytitan/start2archive.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/start2archive.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/start2archive.F	(revision 1056)
@@ -0,0 +1,312 @@
+c=======================================================================
+      PROGRAM start2archive
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Version Venus: 09/2007
+c           Titan: 02/2009
+c
+c   Objet:   Passage des  fichiers netcdf d etat initial "start" et
+c   -----    "startphy" a un fichier netcdf unique "start_archive" 
+c
+c=======================================================================
+
+      USE filtreg_mod
+      USE infotrac
+      USE control_mod
+      use cpdet_mod, only: tpot2t
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comdissnew.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "logic.h"
+#include "temps.h"
+#include "ener.h"
+#include "description.h"
+#include "dimsoil.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c   Declarations
+c-----------------------------------------------------------------------
+
+c variables dynamiques du GCM
+c -----------------------------
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
+      REAL teta(ip1jmp1,llm)                    ! temperature potentielle 
+      REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
+      REAL pks(ip1jmp1)                      ! exner (f pour filtre)
+      REAL pk(ip1jmp1,llm)
+      REAL pkf(ip1jmp1,llm)
+      REAL alpha(iip1,jjp1,llm),beta(iip1,jjp1,llm)
+      REAL phis(ip1jmp1)                     ! geopotentiel au sol
+      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
+      REAL ps(ip1jmp1)                       ! pression au sol
+      REAL p3d(iip1, jjp1, llm+1)            ! pression aux interfaces
+      
+c Variable Physiques (grille physique)
+c ------------------------------------
+      integer ngridmx,nlayermx
+      parameter (ngridmx=(2+(jjm-1)*iim - 1/jjm))
+      parameter (nlayermx=llm)
+
+      real rlat(ngridmx),rlon(ngridmx)
+      REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx)
+      REAL albe(ngridmx),radsol(ngridmx),sollw(ngridmx)
+      real solsw(ngridmx),dlw(ngridmx)
+      REAL zmea(ngridmx), zstd(ngridmx)
+      REAL zsig(ngridmx), zgam(ngridmx), zthe(ngridmx)
+      REAL zpic(ngridmx), zval(ngridmx)
+      
+      INTEGER start,length
+      PARAMETER (length = 100)
+      REAL tab_cntrl_fi(length) ! tableau des parametres de startfi
+      REAL tab_cntrl_dyn(length) ! tableau des parametres de start
+      INTEGER*4 day_ini_fi
+
+c Variable naturelle / grille scalaire
+c ------------------------------------
+      REAL T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm)
+      REAL tsurfS(ip1jmp1),tsoilS(ip1jmp1,nsoilmx)
+      real rlatS(ip1jmp1),rlonS(ip1jmp1)
+      real albeS(ip1jmp1),radsolS(ip1jmp1),sollwS(ip1jmp1)
+      real solswS(ip1jmp1),dlwS(ip1jmp1)
+      real zmeaS(ip1jmp1),zstdS(ip1jmp1),zsigS(ip1jmp1)
+      real zgamS(ip1jmp1),ztheS(ip1jmp1),zpicS(ip1jmp1)
+      real zvalS(ip1jmp1)
+      
+c Variables intermediaires : vent naturel, mais pas coord scalaire
+c----------------------------------------------------------------
+      REAL vn(ip1jm,llm),un(ip1jmp1,llm)
+
+c Autres  variables
+c -----------------
+      REAL ptotal
+
+      CHARACTER*2 str2
+
+      INTEGER ij, l,i,j,isoil,iq
+      character*80      fichnom
+      integer :: ierr
+
+c Netcdf
+c-------
+      integer varid,dimid
+      INTEGER nid
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+c VENUS/TITAN
+
+        iflag_trac = 1
+c-----------------------------------------------------------------------
+c   Initialisation des traceurs
+c   ---------------------------
+c  Choix du nombre de traceurs et du schema pour l advection
+c  dans fichier traceur.def, par default ou via INCA
+      call infotrac_init
+
+c Allocation de la tableau q : champs advectes   
+      allocate(q(ip1jmp1,llm,nqtot))
+
+c=======================================================================
+c Lecture des donnees
+c=======================================================================
+
+      fichnom = 'start.nc'
+      CALL readstart(fichnom,nqtot,vcov,ucov,teta,q,masse,
+     .       ps,phis,tab_cntrl_dyn)
+
+      fichnom = 'startphy.nc'
+      CALL readstartphy(fichnom,
+     .       rlat,rlon,tsurf,tsoil,
+     .       albe, solsw, sollw,
+     .       dlw,radsol,
+     .       zmea,zstd,zsig,zgam,zthe,zpic,zval,
+     .       tab_cntrl_fi)
+
+c-----------------------------------------------------------------------
+c   Initialisations 
+c-----------------------------------------------------------------------
+
+      call iniconst
+      call inigeom
+      call inifilr
+      CALL pression(ip1jmp1, ap, bp, ps, p3d)
+         if (disvert_type==1) then
+           CALL exner_hyb(  ip1jmp1, ps, p3d,alpha,beta,pks, pk, pkf )
+         else ! we assume that we are in the disvert_type==2 case
+           CALL exner_milieu( ip1jmp1, ps, p3d, beta, pks, pk, pkf )
+         endif
+
+c=======================================================================
+c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si necessaire
+c=======================================================================
+c  Les variables modeles dependent de la resolution. Il faut donc
+c  eliminer les facteurs responsables de cette dependance
+c  (pour utiliser newstart)
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Vent   (depend de la resolution horizontale) 
+c-----------------------------------------------------------------------
+c
+c ucov --> un  et  vcov --> vn
+c un --> us  et   vn --> vs
+c
+c-----------------------------------------------------------------------
+
+      call covnat(llm,ucov, vcov, un, vn) 
+      call wind_scal(un,vn,us,vs) 
+
+c-----------------------------------------------------------------------
+c Temperature  (depend de la resolution verticale => de "sigma.def")
+c-----------------------------------------------------------------------
+c
+c h --> T
+c
+c-----------------------------------------------------------------------
+! ADAPTATION GCM POUR CP(T)
+
+      call tpot2t(ip1jmp1*llm,teta,T,pk)
+
+c-----------------------------------------------------------------------
+c Variable physique 
+c-----------------------------------------------------------------------
+c
+c tsurf --> tsurfS
+c et autres...
+c
+c-----------------------------------------------------------------------
+
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS)
+      call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rlat,rlatS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,rlon,rlonS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,albe,albeS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,radsol,radsolS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,sollw,sollwS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,solsw,solswS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,dlw,dlwS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zmea,zmeaS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zstd,zstdS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zsig,zsigS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zgam,zgamS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zthe,ztheS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zpic,zpicS)
+      call gr_fi_dyn(1,ngridmx,iip1,jjp1,zval,zvalS)
+
+c=======================================================================
+c Info pour controler
+c=======================================================================
+
+      ptotal =  0.
+      DO j=1,jjp1
+         DO i=1,iim
+           ptotal=ptotal+aire(i+(iim+1)*(j-1))*ps(i+(iim+1)*(j-1))/g
+         ENDDO
+      ENDDO
+      write(*,*)'Ancienne grille : masse de l''atm :',ptotal
+
+c-----------------------------------------------------------------------
+c Passage de "ptotal" par tab_cntrl_fi
+c-----------------------------------------------------------------------
+
+      tab_cntrl_fi(length) = ptotal
+
+c=======================================================================
+c Ecriture dans le fichier  "start_archive"
+c=======================================================================
+
+c-----------------------------------------------------------------------
+c Ouverture de "start_archive" 
+c-----------------------------------------------------------------------
+
+      ierr = NF_OPEN ('start_archive.nc', NF_WRITE,nid)
+ 
+c-----------------------------------------------------------------------
+c  si "start_archive" n'existe pas:
+c    1_ ouverture
+c    2_ creation de l'entete dynamique ("ini_archive")
+c-----------------------------------------------------------------------
+c ini_archive:
+c On met dans l'entete le tab_cntrl_dyn (1 a length) 
+c  On y ajoute les valeurs du tab_cntrl_fi (length+1 a 2*length)
+c-----------------------------------------------------------------------
+
+      if (ierr.ne.NF_NOERR) then
+         write(*,*)'OK, Could not open file "start_archive.nc"'
+         write(*,*)'So let s create a new "start_archive"'
+         ierr = NF_CREATE('start_archive.nc', NF_CLOBBER, nid)
+         call ini_archive(nid,phis,tab_cntrl_dyn,tab_cntrl_fi)
+      else
+         write(*,*)'Attention, start_archive.nc existe deja...'
+	 call abort
+      endif
+
+c-----------------------------------------------------------------------
+c Ecriture des champs 
+c-----------------------------------------------------------------------
+
+      call write_archive(nid,'u','Vent zonal','m.s-1',3,us)
+      call write_archive(nid,'v','Vent merid','m.s-1',3,vs)
+      call write_archive(nid,'temp','temperature','K',3,T)
+c-----------------------------------------------------------------------
+c Ecriture du champs  q  ( q[1,nqtot] )
+c-----------------------------------------------------------------------
+       do iq=1,nqtot
+        write(str2,'(i2.2)') iq
+         call write_archive(nid,tname(iq),'tracer','kg/kg',
+     .         3,q(1,1,iq))
+       end do
+c-----------------------------------------------------------------------
+      call write_archive(nid,'masse','Masse','kg',3,masse)
+      call write_archive(nid,'ps','Psurf','Pa',2,ps)
+      call write_archive(nid,'tsurf','surf T','K',2,tsurfS)
+c-----------------------------------------------------------------------
+c Ecriture du champs  tsoil  ( Tsoil[1,nsoilmx] )
+c-----------------------------------------------------------------------
+c "tsoil" Temperature au sol definie dans nsoilmx couches dans le sol
+c   Les nsoilmx couches sont lues comme nsoilmx champs 
+c  nommees Tsoil[1,nsoilmx]
+      do isoil=1,nsoilmx
+       write(str2,'(i2.2)') isoil
+       call write_archive(nid,'Tsoil'//str2,'Ground Temperature ',
+     .   'K',2,tsoilS(1,isoil))
+      enddo
+c-----------------------------------------------------------------------
+      call write_archive(nid,'rlat','Latitude','rad',2,rlatS)
+      call write_archive(nid,'rlon','Longitude','rad',2,rlonS)
+      call write_archive(nid,'albe','Albedo','',2,albeS)
+      call write_archive(nid,'radsol',
+     .             'Net flux at surface','W m-2',2,radsolS)
+      call write_archive(nid,'sollw',
+     .             'LW flux at surface','W m-2',2,sollwS)
+      call write_archive(nid,'solsw',
+     .             'SW flux at surface','W m-2',2,solswS)
+      call write_archive(nid,'dlw','LW derive','?',2,dlwS)
+      call write_archive(nid,'zmea','param oro sous-maille','m',2,zmeaS)
+      call write_archive(nid,'zstd','param oro sous-maille','m',2,zstdS)
+      call write_archive(nid,'zsig','param oro sous-maille','m',2,zsigS)
+      call write_archive(nid,'zgam','param oro sous-maille','m',2,zgamS)
+      call write_archive(nid,'zthe','param oro sous-maille','m',2,ztheS)
+      call write_archive(nid,'zpic','param oro sous-maille','m',2,zpicS)
+      call write_archive(nid,'zval','param oro sous-maille','m',2,zvalS)
+
+      ierr=NF_CLOSE(nid)
+
+c-----------------------------------------------------------------------
+c Fin 
+c-----------------------------------------------------------------------
+
+      end 
Index: trunk/LMDZ.TITAN/libf/phytitan/startvar.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/startvar.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/startvar.F90	(revision 1056)
@@ -0,0 +1,770 @@
+!
+! $Id: startvar.F90 1425 2010-09-02 13:45:23Z lguez $
+!
+!*******************************************************************************
+!
+MODULE startvar
+!
+!*******************************************************************************
+!
+!-------------------------------------------------------------------------------
+! Purpose: Access data from the database of atmospheric to initialize the model.
+!-------------------------------------------------------------------------------
+! Comments:
+!
+!    *  This module is designed to work for Earth (and with ioipsl)
+!
+!    *  There are three ways to acces data, depending on the type of field
+!  which needs to be extracted. In any case the call should come after a restget
+!  and should be of the type :                     CALL startget(...)
+!
+!  - A 1D variable on the physical grid :
+!    CALL startget_phys1d((varname, iml, jml,  lon_in,  lat_in,  nbindex,              &
+!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )
+!
+!  - A 2D variable on the dynamical grid :
+!    CALL startget_phys2d(varname, iml, jml,  lon_in,  lat_in,                        &
+!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )             
+!
+!  - A 3D variable on the dynamical grid :
+!    CALL startget_dyn((varname, iml, jml,  lon_in,  lat_in,  lml, pls, workvar,    &
+!           champ, val_exp,      jml2, lon_in2, lat_in2, ibar )
+!
+!    *  Data needs to be in NetCDF format
+!
+!    *  Variables should have the following names in the files:
+!            'RELIEF' : High resolution orography 
+!            'ST'     : Surface temperature
+!            'CDSW'   : Soil moisture
+!            'Z'      : Surface geopotential
+!            'SP'     : Surface pressure
+!            'U'      : East ward wind
+!            'V'      : Northward wind
+!            'TEMP'   : Temperature
+!            'R'      : Relative humidity
+!
+!   *   There is a big mess with the longitude size. Should it be iml or iml+1 ?
+!  I have chosen to use the iml+1 as an argument to this routine and we declare
+!  internaly smaller fields when needed. This needs to be cleared once and for
+!  all in LMDZ. A convention is required.
+!-------------------------------------------------------------------------------
+  USE ioipsl
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC startget_phys2d, startget_phys1d, startget_dyn
+!  INTERFACE startget
+!    MODULE PROCEDURE startget_phys1d, startget_phys2d, startget_dyn
+!  END INTERFACE
+
+  REAL,    SAVE :: deg2rad,  pi
+  INTEGER, SAVE ::           iml_rel,  jml_rel
+  INTEGER, SAVE :: fid_phys, iml_phys, jml_phys
+  INTEGER, SAVE :: fid_dyn,  iml_dyn,  jml_dyn,  llm_dyn,  ttm_dyn
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lon_phys, lon_dyn
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lat_phys, lat_dyn
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lon_rug, lon_alb, lon_rel
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: lat_rug, lat_alb, lat_rel
+  REAL, DIMENSION(:),     ALLOCATABLE, TARGET, SAVE :: levdyn_ini
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: relief, zstd, zsig, zgam
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: zthe, zpic, zval
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: rugo, phis, tsol, qsol
+  REAL, DIMENSION(:,:),   ALLOCATABLE, TARGET, SAVE :: psol_dyn
+  REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET, SAVE :: var_ana3d
+
+   CONTAINS
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE startget_phys1d(varname, iml, jml, lon_in, lat_in, nbindex, champ,  &
+                           val_exp ,jml2, lon_in2, lat_in2, ibar)
+!
+!-------------------------------------------------------------------------------
+! Comment:
+!   This routine only works if the variable does not exist or is constant.
+!-------------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*),         INTENT(IN)    :: varname
+  INTEGER,                  INTENT(IN)    :: iml, jml
+  REAL, DIMENSION(iml),     INTENT(IN)    :: lon_in
+  REAL, DIMENSION(jml),     INTENT(IN)    :: lat_in
+  INTEGER,                  INTENT(IN)    :: nbindex
+  REAL, DIMENSION(nbindex), INTENT(INOUT) :: champ
+  REAL,                     INTENT(IN)    :: val_exp
+  INTEGER,                  INTENT(IN)    :: jml2
+  REAL, DIMENSION(iml),     INTENT(IN)    :: lon_in2
+  REAL, DIMENSION(jml2),    INTENT(IN)    :: lat_in2
+  LOGICAL,                  INTENT(IN)    :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  REAL, DIMENSION(:,:), POINTER :: v2d
+!-------------------------------------------------------------------------------
+  v2d=>NULL()
+  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
+
+!--- CHECKING IF THE FIELD IS KNOWN ; READING UNALLOCATED FILES
+    SELECT CASE(varname)
+      CASE('tsol')
+        IF(.NOT.ALLOCATED(tsol))                                               &
+         CALL start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('qsol')
+        IF(.NOT.ALLOCATED(qsol))                                               &
+         CALL start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('psol')
+        IF(.NOT.ALLOCATED(psol_dyn))                                           &
+         CALL start_init_dyn (iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('zmea','zstd','zsig','zgam','zthe','zpic','zval')
+        IF(.NOT.ALLOCATED(relief))                                             &
+         CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE('rads','snow','tslab','seaice','rugmer','agsno')
+      CASE DEFAULT
+        WRITE(lunout,*)'startget_phys1d'
+        WRITE(lunout,*)'No rule is present to extract variable '//TRIM(varname)&
+                     //' from any data set'; STOP
+    END SELECT
+
+!--- SELECTING v2d FOR WANTED VARIABLE AND CHEKING ITS SIZE
+    SELECT CASE(varname)
+      CASE('rads','snow','tslab','seaice');  champ=0.0
+      CASE('rugmer');                        champ(:)=0.001
+      CASE('agsno');                         champ(:)=50.0
+      CASE DEFAULT
+        SELECT CASE(varname)
+          CASE('tsol'); v2d=>tsol
+          CASE('qsol'); v2d=>qsol
+          CASE('psol'); v2d=>psol_dyn
+          CASE('zmea'); v2d=>relief
+          CASE('zstd'); v2d=>zstd
+          CASE('zsig'); v2d=>zsig
+          CASE('zgam'); v2d=>zgam
+          CASE('zthe'); v2d=>zthe
+          CASE('zpic'); v2d=>zpic
+          CASE('zval'); v2d=>zval
+        END SELECT
+        IF(SIZE(v2d)/=SIZE(lon_in)*SIZE(lat_in)) THEN
+         WRITE(lunout,*)'STARTVAR module has been initialized to the wrong size'
+         STOP
+        END IF
+        CALL gr_dyn_fi(1,iml,jml,nbindex,v2d,champ)
+    END SELECT
+
+  ELSE
+
+!--- SOME FIELDS ARE CAUGHT: MAY BE NEEDED FOR A 3D INTEPROLATION
+    SELECT CASE(varname)
+      CASE('tsol')
+        IF(.NOT.ALLOCATED(tsol)) ALLOCATE(tsol(iml,jml))
+        CALL gr_fi_dyn(1,iml,jml,nbindex,champ,tsol)
+    END SELECT
+
+  END IF
+
+END SUBROUTINE  startget_phys1d
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE startget_phys2d(varname, iml, jml, lon_in, lat_in, champ, val_exp,  &
+                           jml2, lon_in2, lat_in2 , ibar)
+!
+!-------------------------------------------------------------------------------
+! Comment:
+!   This routine only works if the variable does not exist or is constant.
+!-------------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*),         INTENT(IN)           :: varname
+  INTEGER,                  INTENT(IN)           :: iml, jml
+  REAL, DIMENSION(iml),     INTENT(IN)           :: lon_in
+  REAL, DIMENSION(jml),     INTENT(IN)           :: lat_in
+  REAL, DIMENSION(iml,jml), INTENT(INOUT)        :: champ
+  REAL,                     INTENT(IN)           :: val_exp
+  INTEGER,                  INTENT(IN)           :: jml2
+  REAL, DIMENSION(iml),     INTENT(IN)           :: lon_in2
+  REAL, DIMENSION(jml2),    INTENT(IN)           :: lat_in2
+  LOGICAL,                  INTENT(IN)           :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  REAL, DIMENSION(:,:), POINTER :: v2d=>NULL()
+!-------------------------------------------------------------------------------
+  v2d=>NULL()
+  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
+
+!--- CHECKING IF THE FIELD IS KNOWN ; READING UNALLOCATED FILES
+    SELECT CASE(varname)
+      CASE('psol')
+        IF(.NOT.ALLOCATED(psol_dyn))                                           &
+          CALL start_init_dyn (iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+      CASE('relief')
+        IF(.NOT.ALLOCATED(relief)) CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE('surfgeo')
+        IF(.NOT.ALLOCATED(phis)) CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE('rugosite')
+        IF(.NOT.ALLOCATED(rugo)) CALL start_init_orog(iml,jml,lon_in,lat_in)
+      CASE DEFAULT
+        WRITE(lunout,*)'startget_phys2d'
+        WRITE(lunout,*)'No rule is present to extract variable '//TRIM(varname)&
+                     //' from any data set'; STOP
+    END SELECT
+
+!--- SELECTING v2d FOR WANTED VARIABLE AND CHEKING ITS SIZE
+    SELECT CASE(varname)
+      CASE('psol');     v2d=>psol_dyn
+      CASE('relief');   v2d=>relief
+      CASE('rugosite'); v2d=>rugo
+      CASE('surfgeo');  v2d=>phis
+    END SELECT
+    IF(SIZE(champ)/=SIZE(v2d)) THEN
+      WRITE(lunout,*) 'STARTVAR module has been initialized to the wrong size'
+      STOP
+    END IF
+
+    champ(:,:)=v2d(:,:)
+
+  ELSE
+
+!--- SOME FIELDS ARE CAUGHT: MAY BE NEEDED FOR A 3D INTEPROLATION
+    SELECT CASE(varname)
+      CASE ('surfgeo')
+        IF(.NOT.ALLOCATED(phis)) ALLOCATE(phis(iml,jml))
+        IF(SIZE(phis)/=SIZE(champ)) THEN
+         WRITE(lunout,*)'STARTVAR module has been initialized to the wrong size'
+         STOP
+        END IF
+        phis(:,:)=champ(:,:)
+    END SELECT
+
+  END IF
+
+END SUBROUTINE startget_phys2d
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE startget_dyn(varname,  lon_in,  lat_in, pls,workvar,&
+                     champ, val_exp, lon_in2, lat_in2, ibar)
+
+      use assert_eq_m, only: assert_eq
+
+
+!-------------------------------------------------------------------------------
+! Comment:
+!   This routine only works if the variable does not exist or is constant.
+!-------------------------------------------------------------------------------
+! Arguments:
+  CHARACTER(LEN=*), INTENT(IN)    :: varname
+  REAL, INTENT(IN)    :: lon_in(:) ! dim(iml)
+  REAL, INTENT(IN)    :: lat_in(:) ! dim(jml)
+  REAL, INTENT(IN)    :: pls(:, :, :) ! dim(iml, jml, lml)
+  REAL, INTENT(IN)    :: workvar(:, :, :) ! dim(iml, jml, lml)
+  REAL, INTENT(INOUT) :: champ(:, :, :) ! dim(iml, jml, lml)
+  REAL, INTENT(IN)    :: val_exp
+  REAL, INTENT(IN)    :: lon_in2(:) ! dim(iml)
+  REAL, INTENT(IN)    :: lat_in2(:) ! dim(jml2)
+  LOGICAL,                      INTENT(IN)    :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+#include "dimensions.h"
+#include "comconst.h"
+#include "paramet.h"
+#include "comgeom2.h"
+  INTEGER    :: iml, jml
+  INTEGER    :: lml
+  INTEGER    :: jml2
+  REAL, DIMENSION(:,:,:), POINTER :: v3d=>NULL()
+  CHARACTER(LEN=10) :: vname
+  INTEGER :: il
+  REAL    :: xppn, xpps
+!-------------------------------------------------------------------------------
+  NULLIFY(v3d)
+  IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
+
+      iml = assert_eq((/size(lon_in), size(pls, 1), size(workvar, 1), &
+     &     size(champ, 1), size(lon_in2)/), "startget_dyn iml")
+      jml = assert_eq(size(lat_in), size(pls, 2), size(workvar, 2),   &
+     &     size(champ, 2), "startget_dyn jml")
+      lml = assert_eq(size(pls, 3), size(workvar, 3), size(champ, 3), &
+     &     "startget_dyn lml")
+      jml2 = size(lat_in2)
+
+!--- READING UNALLOCATED FILES
+    IF(.NOT.ALLOCATED(psol_dyn))                                               &
+      CALL start_init_dyn(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+
+!--- CHECKING IF THE FIELD IS KNOWN AND INTERPOLATING 3D FIELDS
+    SELECT CASE(varname)
+      CASE('u');        vname='U'
+      CASE('v');        vname='V'
+      CASE('t','tpot'); vname='TEMP'
+      CASE('q');        vname='R'
+      CASE DEFAULT
+        WRITE(lunout,*)'startget_dyn'
+        WRITE(lunout,*)'No rule is present to extract variable '//TRIM(varname)&
+                //' from any data set'; STOP
+    END SELECT
+    CALL start_inter_3d(TRIM(vname), iml, jml, lml, lon_in, lat_in, jml2,      &
+                        lon_in2, lat_in2,  pls, champ,ibar )
+
+!--- COMPUTING THE REQUIRED FILED
+    SELECT CASE(varname)
+      CASE('u')                                            !--- Eastward wind
+        DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
+        champ(iml,:,:)=champ(1,:,:)
+
+      CASE('v')                                            !--- Northward wind
+        DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
+        champ(iml,:,:)=champ(1,:,:)
+
+      CASE('tpot')                                         !--- Temperature
+        IF(MINVAL(workvar)/=MAXVAL(workvar)) THEN
+          champ=champ*cpp/workvar
+          DO il=1,lml
+            xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
+            xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
+            champ(:,1  ,il) = xppn
+            champ(:,jml,il) = xpps
+          END DO
+        ELSE
+          WRITE(lunout,*)'Could not compute potential temperature as the'
+          WRITE(lunout,*)'Exner function is missing or constant.'; STOP
+        END IF
+
+      CASE('q')                                            !--- Relat. humidity
+        IF(MINVAL(workvar)/=MAXVAL(workvar)) THEN
+          champ=0.01*champ*workvar
+          WHERE(champ<0.) champ=1.0E-10
+          DO il=1,lml
+            xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
+            xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
+            champ(:,1  ,il) = xppn
+            champ(:,jml,il) = xpps
+          END DO
+        ELSE
+          WRITE(lunout,*)'Could not compute specific humidity as the'
+          WRITE(lunout,*)'saturated humidity is missing or constant.'; STOP
+        END IF
+
+    END SELECT
+
+  END IF
+
+END SUBROUTINE startget_dyn
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_init_orog(iml,jml,lon_in,lat_in)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,                  INTENT(IN)           :: iml, jml
+  REAL, DIMENSION(iml),     INTENT(IN)           :: lon_in
+  REAL, DIMENSION(jml),     INTENT(IN)           :: lat_in
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+#include "comconst.h"
+  CHARACTER(LEN=25)     :: title
+  CHARACTER(LEN=120)    :: orofname
+  LOGICAL               :: check=.TRUE.
+  REAL,    DIMENSION(1) :: lev
+  REAL                  :: date, dt
+  INTEGER, DIMENSION(1) :: itau
+  INTEGER               :: fid, llm_tmp, ttm_tmp
+  REAL,    DIMENSION(:,:), ALLOCATABLE :: relief_hi, tmp_var
+  REAL,    DIMENSION(:),   ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+!-------------------------------------------------------------------------------
+  pi=2.0*ASIN(1.0); deg2rad=pi/180.0
+
+  orofname = 'Relief.nc'; title='RELIEF'
+  IF(check) WRITE(lunout,*)'Reading the high resolution orography'
+  CALL flininfo(orofname, iml_rel, jml_rel, llm_tmp, ttm_tmp, fid)
+
+  ALLOCATE(lat_rel(iml_rel,jml_rel),lon_rel(iml_rel,jml_rel))
+  CALL flinopen(orofname, .FALSE., iml_rel, jml_rel, llm_tmp, lon_rel, lat_rel,&
+                lev, ttm_tmp, itau, date, dt, fid)
+  ALLOCATE(relief_hi(iml_rel,jml_rel))
+  CALL flinget(fid, title, iml_rel, jml_rel, llm_tmp, ttm_tmp, 1, 1, relief_hi)
+  CALL flinclo(fid)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_rel),lat_ini(jml_rel))
+  lon_ini(:)=lon_rel(:,1); IF(MAXVAL(lon_rel)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_rel(1,:); IF(MAXVAL(lat_rel)>pi) lat_ini=lat_ini*deg2rad
+
+!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
+  ALLOCATE(lon_rad(iml_rel),lat_rad(jml_rel))
+  CALL conf_dat2d(title, iml_rel, jml_rel, lon_ini, lat_ini, lon_rad, lat_rad, &
+                  relief_hi, .FALSE.)
+  DEALLOCATE(lon_ini,lat_ini)
+
+!--- COMPUTING THE REQUIRED FIELDS USING ROUTINE grid_noro
+  IF(check) WRITE(lunout,*)'Computes all parameters needed for gravity wave dra&
+     &g code'
+
+  ALLOCATE(phis(iml,jml))      ! Geopotentiel au sol
+  ALLOCATE(zstd(iml,jml))      ! Deviation standard de l'orographie sous-maille
+  ALLOCATE(zsig(iml,jml))      ! Pente de l'orographie sous-maille 
+  ALLOCATE(zgam(iml,jml))      ! Anisotropie de l'orographie sous maille
+  ALLOCATE(zthe(iml,jml))      ! Orientation axe +grande pente d'oro sous maille
+  ALLOCATE(zpic(iml,jml))      ! Hauteur pics de la SSO
+  ALLOCATE(zval(iml,jml))      ! Hauteur vallees de la SSO
+  ALLOCATE(relief(iml,jml))    ! Orographie moyenne
+
+  CALL grid_noro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, iml-1, jml,    &
+       lon_in, lat_in, phis, relief, zstd, zsig, zgam, zthe, zpic, zval)
+  phis = phis * g
+
+!--- SURFACE ROUGHNESS COMPUTATION (UNUSED FOR THE MOMENT !!! )
+  IF(check) WRITE(lunout,*)'Compute surface roughness induced by the orography'
+  ALLOCATE(rugo   (iml  ,jml))
+  ALLOCATE(tmp_var(iml-1,jml))
+  CALL rugsoro(iml_rel, jml_rel, lon_rad, lat_rad, relief_hi, iml-1, jml,      &
+       lon_in, lat_in, tmp_var)
+  rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
+  DEALLOCATE(relief_hi,tmp_var,lon_rad,lat_rad)
+  RETURN
+
+END SUBROUTINE start_init_orog
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,               INTENT(IN) :: iml, jml
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in
+  REAL, DIMENSION(jml),  INTENT(IN) :: lat_in
+  INTEGER,               INTENT(IN) :: jml2
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in2
+  REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2
+  LOGICAL,               INTENT(IN) :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  CHARACTER(LEN=25)     :: title
+  CHARACTER(LEN=120)    :: physfname
+  LOGICAL               :: check=.TRUE.
+  REAL                  :: date, dt
+  INTEGER, DIMENSION(1) :: itau
+  INTEGER               :: llm_tmp, ttm_tmp
+  REAL,    DIMENSION(:,:), ALLOCATABLE :: var_ana
+  REAL,    DIMENSION(:),   ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+  REAL,    DIMENSION(:),   ALLOCATABLE :: levphys_ini
+!-------------------------------------------------------------------------------
+  physfname = 'ECPHY.nc'; pi=2.0*ASIN(1.0); deg2rad=pi/180.0
+  IF(check) WRITE(lunout,*)'Opening the surface analysis'
+  CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)
+
+  ALLOCATE(lat_phys(iml_phys,jml_phys))
+  ALLOCATE(lon_phys(iml_phys,jml_phys))
+  ALLOCATE(levphys_ini(llm_tmp))
+  CALL flinopen(physfname, .FALSE., iml_phys, jml_phys, llm_tmp, lon_phys,     &
+                lat_phys, levphys_ini, ttm_tmp, itau, date, dt, fid_phys)
+  DEALLOCATE(levphys_ini)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_phys),lat_ini(jml_phys))
+  lon_ini(:)=lon_phys(:,1); IF(MAXVAL(lon_phys)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_phys(1,:); IF(MAXVAL(lat_phys)>pi) lat_ini=lat_ini*deg2rad
+
+  ALLOCATE(var_ana(iml_phys,jml_phys),lon_rad(iml_phys),lat_rad(jml_phys))
+
+!--- SURFACE TEMPERATURE
+  title='ST'
+  ALLOCATE(tsol(iml,jml))
+  CALL flinget(fid_phys,title,iml_phys,jml_phys,llm_tmp,ttm_tmp,1,1,var_ana)
+  CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, lon_rad, lat_rad,&
+                  var_ana , ibar  )
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_phys, jml_phys, lon_rad, lat_rad, var_ana, iml, jml, jml-1,          &
+      lon_in,   lat_in,   lon_in2, lat_in2, tsol)
+
+!--- SOIL MOISTURE
+  title='CDSW'
+  ALLOCATE(qsol(iml,jml))
+  CALL flinget(fid_phys,title,iml_phys,jml_phys,llm_tmp,ttm_tmp,1,1,var_ana)
+  CALL conf_dat2d(title,iml_phys, jml_phys, lon_ini, lat_ini, lon_rad, lat_rad,&
+                  var_ana, ibar  )
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_phys, jml_phys, lon_rad, lat_rad, var_ana, iml, jml, jml-1,          &
+      lon_in,   lat_in,   lon_in2, lat_in2, qsol)
+
+  CALL flinclo(fid_phys)
+
+  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
+
+END SUBROUTINE start_init_phys
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_init_dyn(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+!
+!-------------------------------------------------------------------------------
+! Arguments:
+  INTEGER,               INTENT(IN) :: iml, jml
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in
+  REAL, DIMENSION(jml),  INTENT(IN) :: lat_in
+  INTEGER,               INTENT(IN) :: jml2
+  REAL, DIMENSION(iml),  INTENT(IN) :: lon_in2
+  REAL, DIMENSION(jml2), INTENT(IN) :: lat_in2
+  LOGICAL,               INTENT(IN) :: ibar
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom2.h"
+  CHARACTER(LEN=25)     :: title
+  CHARACTER(LEN=120)    :: physfname
+  LOGICAL               :: check=.TRUE.
+  REAL                  :: date, dt
+  INTEGER, DIMENSION(1) :: itau
+  INTEGER               :: i, j
+  REAL,    DIMENSION(:,:), ALLOCATABLE :: var_ana, z
+  REAL,    DIMENSION(:),   ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+  REAL,    DIMENSION(:),   ALLOCATABLE :: xppn, xpps
+!-------------------------------------------------------------------------------
+
+!--- KINETIC ENERGY
+  physfname = 'ECDYN.nc'; pi=2.0*ASIN(1.0); deg2rad=pi/180.0
+  IF(check) WRITE(lunout,*) 'Opening the surface analysis'
+  CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
+  IF(check) WRITE(lunout,*) 'Values read: ', iml_dyn, jml_dyn, llm_dyn, ttm_dyn
+
+  ALLOCATE(lat_dyn(iml_dyn,jml_dyn))
+  ALLOCATE(lon_dyn(iml_dyn,jml_dyn))
+  ALLOCATE(levdyn_ini(llm_dyn))
+  CALL flinopen(physfname, .FALSE., iml_dyn, jml_dyn, llm_dyn, lon_dyn,lat_dyn,&
+                levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_dyn),lat_ini(jml_dyn))
+  lon_ini(:)=lon_dyn(:,1); IF(MAXVAL(lon_dyn)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_dyn(1,:); IF(MAXVAL(lat_dyn)>pi) lat_ini=lat_ini*deg2rad
+
+  ALLOCATE(var_ana(iml_dyn,jml_dyn),lon_rad(iml_dyn),lat_rad(jml_dyn))
+
+!--- SURFACE GEOPOTENTIAL
+  title='Z'
+  ALLOCATE(z(iml,jml))
+  CALL flinget(fid_dyn, title, iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
+  CALL conf_dat2d(title, iml_dyn, jml_dyn, lon_ini, lat_ini, lon_rad, lat_rad, &
+                  var_ana, ibar)
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_dyn, jml_dyn, lon_rad, lat_rad, var_ana, iml, jml, jml-1,            &
+      lon_in,  lat_in,  lon_in2, lat_in2, z)
+
+!--- SURFACE PRESSURE
+  title='SP'
+  ALLOCATE(psol_dyn(iml,jml))
+  CALL flinget(fid_dyn, title, iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
+  CALL conf_dat2d(title, iml_dyn, jml_dyn, lon_ini, lat_ini, lon_rad, lat_rad, &
+                  var_ana, ibar)
+  CALL interp_startvar(title, ibar, .TRUE.,                                    &
+      iml_dyn, jml_dyn, lon_rad, lat_rad, var_ana, iml, jml, jml-1,            &
+      lon_in,  lat_in,  lon_in2, lat_in2, psol_dyn)
+
+  DEALLOCATE(var_ana,lon_rad,lat_rad,lon_ini,lat_ini)
+
+!--- ALLOCATION OF VARIABLES CREATED IN OR COMING FROM RESTART FILE
+  IF(.NOT.ALLOCATED(tsol)) THEN
+    CALL start_init_phys(iml,jml,lon_in,lat_in,jml2,lon_in2,lat_in2,ibar)
+  ELSE
+    IF(SIZE(tsol)/=SIZE(psol_dyn)) THEN
+      WRITE(lunout,*)'start_init_dyn :'
+      WRITE(lunout,*)'The temperature field we have does not have the right size'
+      STOP
+    END IF
+  END IF
+
+  IF(.NOT.ALLOCATED(phis)) THEN
+    CALL start_init_orog(iml,jml,lon_in,lat_in)
+  ELSE
+    IF(SIZE(phis)/=SIZE(psol_dyn)) THEN
+      WRITE(lunout,*)'start_init_dyn :'
+      WRITE(lunout,*)'The orography field we have does not have the right size'
+      STOP
+    END IF
+  END IF
+
+!--- PSOL IS COMPUTED IN PASCALS
+  DO j = 1, jml
+    DO i = 1, iml-1
+      psol_dyn(i,j) = psol_dyn(i,j)*(1.0+(z(i,j)-phis(i,j))/287.0/tsol(i,j))
+    END DO
+    psol_dyn(iml,j) = psol_dyn(1,j)
+  END DO
+  DEALLOCATE(z)
+
+  ALLOCATE(xppn(iml-1),xpps(iml-1)) 
+  DO i = 1, iml-1
+    xppn(i) = aire( i,1) * psol_dyn( i,1)
+    xpps(i) = aire( i,jml) * psol_dyn( i,jml)
+  END DO
+  DO i = 1, iml
+    psol_dyn(i,1  ) = SUM(xppn)/apoln
+    psol_dyn(i,jml) = SUM(xpps)/apols
+  END DO
+  DEALLOCATE(xppn,xpps) 
+
+  RETURN
+
+END SUBROUTINE start_init_dyn
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE start_inter_3d(varname, iml, jml, lml, lon_in, lat_in, jml2, &
+     lon_in2, lat_in2, pls_in, var3d, ibar)
+
+  use pchsp_95_m, only: pchsp_95
+  use pchfe_95_m, only: pchfe_95
+
+! Arguments:
+  CHARACTER(LEN=*),             INTENT(IN)    :: varname
+  INTEGER,                      INTENT(IN)    :: iml, jml, lml
+  REAL, DIMENSION(iml),         INTENT(IN)    :: lon_in
+  REAL, DIMENSION(jml),         INTENT(IN)    :: lat_in
+  INTEGER,                      INTENT(IN)    :: jml2
+  REAL, DIMENSION(iml),         INTENT(IN)    :: lon_in2
+  REAL, DIMENSION(jml2),        INTENT(IN)    :: lat_in2
+  REAL, DIMENSION(iml, jml, lml), INTENT(IN)    :: pls_in
+  REAL, DIMENSION(iml, jml, lml), INTENT(OUT)   :: var3d
+  LOGICAL,                      INTENT(IN)    :: ibar
+!----------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  LOGICAL:: check=.TRUE., skip
+  REAL                  chmin, chmax
+  INTEGER ii, ij, il, ierr
+  integer n_extrap ! number of extrapolated points
+  REAL, DIMENSION(iml, jml, llm_dyn):: var_tmp3d
+  REAL,    DIMENSION(:),     ALLOCATABLE :: lon_rad, lat_rad, lon_ini, lat_ini
+  REAL, DIMENSION(llm_dyn):: lev_dyn, ax, ay, yder
+
+!---------------------------------------------------------------------------
+  IF(check) WRITE(lunout, *)'Going into flinget to extract the 3D  field.'
+  IF(check) WRITE(lunout, *) fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, &
+       ttm_dyn
+  IF(check) WRITE(lunout, *) 'Allocating space for interpolation', iml, jml, &
+       llm_dyn
+
+  IF(.NOT.ALLOCATED(var_ana3d)) ALLOCATE(var_ana3d(iml_dyn, jml_dyn, llm_dyn))
+  CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &
+       var_ana3d)
+
+!--- IF ANGLES ARE IN DEGREES, THEY ARE CONVERTED INTO RADIANS
+  ALLOCATE(lon_ini(iml_dyn), lat_ini(jml_dyn))
+  lon_ini(:)=lon_dyn(:, 1); IF(MAXVAL(lon_dyn)>pi) lon_ini=lon_ini*deg2rad
+  lat_ini(:)=lat_dyn(1, :); IF(MAXVAL(lat_dyn)>pi) lat_ini=lat_ini*deg2rad
+
+!--- FIELDS ARE PROCESSED TO BE ON STANDARD ANGULAR DOMAINS
+  ALLOCATE(lon_rad(iml_dyn), lat_rad(jml_dyn))
+  CALL conf_dat3d (varname, iml_dyn, jml_dyn, llm_dyn, lon_ini, lat_ini,      &
+                   levdyn_ini, lon_rad, lat_rad, lev_dyn, var_ana3d, ibar)
+  DEALLOCATE(lon_ini, lat_ini)
+
+!--- COMPUTING THE REQUIRED FIELDS USING ROUTINE grid_noro
+  DO il=1, llm_dyn
+    CALL interp_startvar(varname, ibar, il==1, iml_dyn, jml_dyn, lon_rad, &
+         lat_rad, var_ana3d(:, :, il), iml, jml, jml2, lon_in, lat_in, &
+         lon_in2, lat_in2, var_tmp3d(:, :, il))
+  END DO
+  DEALLOCATE(lon_rad, lat_rad)
+
+!--- VERTICAL INTERPOLATION IS PERFORMED FROM TOP OF ATMOSPHERE TO GROUND
+  ax = lev_dyn(llm_dyn:1:-1) 
+  skip = .false.
+  n_extrap = 0
+  DO ij=1, jml
+    DO ii=1, iml-1
+      ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
+      yder = pchsp_95(ax, ay, ibeg=2, iend=2, vc_beg=0., vc_end=0.)
+      CALL pchfe_95(ax, ay, yder, skip, pls_in(ii, ij, lml:1:-1), &
+           var3d(ii, ij, lml:1:-1), ierr)
+      if (ierr < 0) stop 1
+      n_extrap = n_extrap + ierr
+    END DO
+  END DO
+  if (n_extrap /= 0) then
+     print *, "start_inter_3d pchfe_95: n_extrap = ", n_extrap
+  end if
+  var3d(iml, :, :) = var3d(1, :, :) 
+
+  DO il=1, lml
+    CALL minmax(iml*jml, var3d(1, 1, il), chmin, chmax)
+    WRITE(lunout, *)' '//TRIM(varname)//'  min max l ', il, chmin, chmax
+  END DO
+
+END SUBROUTINE start_inter_3d
+!
+!-------------------------------------------------------------------------------
+
+
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE interp_startvar(vname, ibar, ibeg, ii, jj,    lon,  lat,  vari,     &
+                                 i1, j1, j2, lon1, lat1, lon2, lat2, varo)
+!
+!-------------------------------------------------------------------------------
+
+  USE inter_barxy_m, only: inter_barxy
+
+! Arguments:
+  CHARACTER(LEN=*),       INTENT(IN)  :: vname
+  LOGICAL,                INTENT(IN)  :: ibar, ibeg
+  INTEGER,                INTENT(IN)  :: ii, jj
+  REAL, DIMENSION(ii),    INTENT(IN)  :: lon
+  REAL, DIMENSION(jj),    INTENT(IN)  :: lat
+  REAL, DIMENSION(ii,jj), INTENT(IN)  :: vari
+  INTEGER,                INTENT(IN)  :: i1, j1, j2
+  REAL, DIMENSION(i1),    INTENT(IN)  :: lon1
+  REAL, DIMENSION(j1),    INTENT(IN)  :: lat1
+  REAL, DIMENSION(i1),    INTENT(IN)  :: lon2
+  REAL, DIMENSION(j2),    INTENT(IN)  :: lat2
+  REAL, DIMENSION(i1,j1), INTENT(OUT) :: varo
+!-------------------------------------------------------------------------------
+! Local variables:
+#include "iniprint.h"
+  REAL, DIMENSION(i1-1,j1) :: vtmp
+!-------------------------------------------------------------------------------
+  IF(ibar) THEN
+    IF(ibeg) THEN
+      WRITE(lunout,*)                                                          &
+               '---------------------------------------------------------------'
+      WRITE(lunout,*)                                                          &
+ '$$$ Utilisation de l interpolation barycentrique  pour  '//TRIM(vname)//' $$$'
+      WRITE(lunout,*)                                                          &
+               '---------------------------------------------------------------'
+    END IF
+    CALL inter_barxy(lon, lat(:jj-1), vari, lon2(:i1-1), lat2(:j2), vtmp)
+  ELSE
+    CALL grille_m   (ii, jj,   lon, lat, vari, i1-1, j1, lon1, lat1,     vtmp)
+  END IF
+  CALL gr_int_dyn(vtmp, varo, i1-1, j1)
+
+END SUBROUTINE interp_startvar
+!
+!-------------------------------------------------------------------------------
+
+END MODULE startvar
+!
+!*******************************************************************************
Index: trunk/LMDZ.TITAN/libf/phytitan/sugwd.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/sugwd.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/sugwd.F	(revision 1056)
@@ -0,0 +1,188 @@
+      SUBROUTINE SUGWD(NLON,NLEV,paprs,pplay)
+C     
+C
+C**** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG
+C
+C     PURPOSE.
+C     --------
+C           INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE
+C           GRAVITY WAVE DRAG PARAMETRIZATION.
+C    VERY IMPORTANT:
+C    ______________
+C           THIS ROUTINE SET_UP THE "TUNABLE PARAMETERS" OF THE
+C           VARIOUS SSO SCHEMES
+C
+C**   INTERFACE.
+C     ----------
+C        CALL *SUGWD* FROM *SUPHEC*
+C              -----        ------
+C (called not from suphec but from first call of physiq.F)
+C
+C        EXPLICIT ARGUMENTS :
+C        --------------------
+C        PAPRS,PPLAY : Pressure at semi and full model levels
+C        NLEV        : number of model levels
+c        NLON        : number of points treated in the physics
+C
+C        IMPLICIT ARGUMENTS :
+C        --------------------
+C        COMMON YOEGWD
+C-GFRCRIT-R:  Critical Non-dimensional mountain Height
+C             (HNC in (1),    LOTT 1999)
+C-GKWAKE--R:  Bluff-body drag coefficient for low level wake
+C             (Cd in (2),     LOTT 1999)
+C-GRCRIT--R:  Critical Richardson Number 
+C             (Ric, End of first column p791 of LOTT 1999) 
+C-GKDRAG--R:  Gravity wave drag coefficient
+C             (G in (3),      LOTT 1999)
+C-GKLIFT--R:  Mountain Lift coefficient
+C             (Cl in (4),     LOTT 1999)
+C-GHMAX---R:  Not used
+C-GRAHILO-R:  Set-up the trapped waves fraction
+C             (Beta , End of first column,  LOTT 1999)
+C
+C-GSIGCR--R:  Security value for blocked flow depth
+C-NKTOPG--I:  Security value for blocked flow level
+C-NTOP----I:  An estimate to qualify the upper levels of
+C             the model where one wants to impose strees
+C             profiles
+C-GSSECC--R:  Security min value for low-level B-V frequency
+C-GTSEC---R:  Security min value for anisotropy and GW stress.
+C-GVSEC---R:  Security min value for ulow
+C         
+C
+C     METHOD.
+C     -------
+C        SEE DOCUMENTATION
+C
+C     EXTERNALS.
+C     ----------
+C        NONE
+C
+C     REFERENCE.
+C     ----------
+C     Lott, 1999: Alleviation of stationary biases in a GCM through...
+C                 Monthly Weather Review, 127, pp 788-801.
+C
+C     AUTHOR.
+C     -------
+C        FRANCOIS LOTT        *LMD*
+C
+C     MODIFICATIONS.
+C     --------------
+C        ORIGINAL : 90-01-01 (MARTIN MILLER, ECMWF)
+C        LAST:  99-07-09     (FRANCOIS LOTT,LMD)
+C     ------------------------------------------------------------------
+      use dimphy
+      IMPLICIT NONE
+
+#include "dimensions.h"
+#include "paramet.h"
+
+#include "YOEGWD.h"
+C
+C  ARGUMENTS
+      integer nlon,nlev
+      REAL paprs(nlon,nlev+1)
+      REAL pplay(nlon,nlev)
+C
+      INTEGER JK
+      REAL ZPR,ZTOP,ZSIGT,ZPM1R
+
+C
+C*       1.    SET THE VALUES OF THE PARAMETERS
+C              --------------------------------
+C
+ 100  CONTINUE
+C
+      PRINT *,' DANS SUGWD NLEV=',NLEV
+      GHMAX=10000.
+C
+      ZPR=100000.
+      ZTOP=0.001 
+c valeurs dans la dernière routine de FLott
+c      ZSIGT=0.94
+c valeurs dans les routines Mars
+      ZSIGT=0.85
+C
+Coff  CALL gather(pplay,pplay_glo)
+Coff  CALL bcast(pplay_glo)
+Coff  CALL gather(paprs,paprs_glo)
+Coff  CALL bcast(paprs_glo)
+
+      DO 110 JK=1,NLEV
+Coff  ZPM1R=pplay_glo(klon_glo/2,jk)/paprs_glo(klon_glo/2,1) 
+      ZPM1R=pplay(klon/2,jk)/paprs(klon/2,1) 
+      IF(ZPM1R.GE.ZSIGT)THEN
+         nktopg=JK
+      ENDIF
+Coff  ZPM1R=pplay_glo(klon_glo/2,jk)/paprs_glo(klon_glo/2,1) 
+      ZPM1R=pplay(klon/2,jk)/paprs(klon/2,1) 
+      IF(ZPM1R.GE.ZTOP)THEN
+         ntop=JK
+      ENDIF
+  110 CONTINUE
+c
+c  inversion car dans orodrag on compte les niveaux a l'envers
+      nktopg=nlev-nktopg+1
+      ntop=nlev-ntop
+      print *,' DANS SUGWD nktopg=', nktopg
+      print *,' DANS SUGWD ntop=', ntop
+C
+      GSIGCR=0.80
+C
+c valeurs dans la dernière routine de FLott
+c      GKDRAG=0.1875
+c      GRAHILO=0.1   
+c      GRCRIT=1.00 
+c      GFRCRIT=1.00
+c      GKWAKE=0.50
+C
+c      GKLIFT=0.25
+c      GVCRIT =0.1
+
+c valeurs dans les routines Mars
+      GKDRAG=0.1
+      GRAHILO=1.0   
+      GRCRIT=0.25 
+      GFRCRIT=1.00
+      GKWAKE=1.0
+C
+      GKLIFT=0.25
+      GVCRIT =0.0
+
+      WRITE(UNIT=6,FMT='('' *** SSO essential constants ***'')')
+      WRITE(UNIT=6,FMT='('' *** SPECIFIED IN SUGWD ***'')')
+      WRITE(UNIT=6,FMT='('' Gravity wave ct '',E13.7,'' '')')GKDRAG
+      WRITE(UNIT=6,FMT='('' Trapped/total wave dag '',E13.7,'' '')')
+     S      GRAHILO
+      WRITE(UNIT=6,FMT='('' Critical Richardson   = '',E13.7,'' '')')
+     S                  GRCRIT
+      WRITE(UNIT=6,FMT='('' Critical Froude'',e13.7)') GFRCRIT
+      WRITE(UNIT=6,FMT='('' Low level Wake bluff cte'',e13.7)') GKWAKE
+      WRITE(UNIT=6,FMT='('' Low level lift  cte'',e13.7)') GKLIFT
+
+C
+C
+C      ----------------------------------------------------------------
+C
+C*       2.    SET VALUES OF SECURITY PARAMETERS
+C              ---------------------------------
+C
+ 200  CONTINUE
+C
+c valeurs dans la dernière routine de FLott
+c      GVSEC=0.10
+c      GSSEC=0.0001
+C
+c      GTSEC=0.00001
+C
+c valeurs dans les routines Mars
+      GVSEC=0.10
+      GSSEC=1.e-12
+C
+      GTSEC=1.e-7
+C
+      RETURN
+      END
+
Index: trunk/LMDZ.TITAN/libf/phytitan/tholin_cvd.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/tholin_cvd.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/tholin_cvd.F	(revision 1056)
@@ -0,0 +1,200 @@
+      SUBROUTINE THOLIN_CVD(WLNMETERS,XNR,XNI)   ! original 
+C THIS ROUTINE RETURNS THE OPTICAL CONSTANTS OF LABORATORY PRODUCED
+C FOR WAVELN ABOVE AND BELOW THE DATA, VALUES ARE EXTRAPOLATED AS
+CONSTANT
+      DIMENSION W(385),XN(385),XK(385)
+
+      data W/
+     &314.0367,303.2380,292.8110,282.7425,273.0199,263.6319,254.5665,
+     &245.8130,237.3603,229.3791,225.0075,220.7190,216.5123,212.3858,
+     &208.3380,204.3672,200.4722,196.6515,192.9034,189.2269,185.6204,
+     &182.0827,178.6123,175.2082,171.9691,169.6769,167.4153,165.1838,
+     &162.9822,160.8098,158.6664,156.5516,154.4649,152.4061,150.3746,
+     &148.3703,146.3927,144.4415,142.5163,140.6907,139.3035,137.9300,
+     &136.5701,135.2235,133.8902,132.5701,131.2629,129.9687,128.6872,
+     &127.4184,126.1621,124.9181,123.6865,122.4669,120.8540,117.6756,
+     &114.5806,111.5671,108.6329,105.7758,102.9938,100.2851, 97.6476,
+     & 95.0794, 92.5788, 90.1439, 87.7731, 85.4646, 83.2169, 81.0670,
+     & 79.0859, 77.1533, 75.2678, 73.4285, 71.6340, 69.8835, 68.1757,
+     & 66.5097, 64.8843, 63.2987, 61.7519, 60.2428, 58.7706, 57.3344,
+     & 55.8598, 54.2566, 52.6993, 51.1868, 49.7176, 48.2906, 46.9046,
+     & 45.5584, 44.2508, 42.9807, 41.7471, 40.5489, 39.3851, 38.2547,
+     & 37.1567, 36.3218, 35.9298, 35.5420, 35.1584, 34.7789, 34.4036,
+     & 34.0323, 33.6650, 33.3016, 32.9422, 32.5867, 32.2350, 31.8871,
+     & 31.5429, 31.2025, 30.7221, 30.0381, 29.3693, 28.7155, 28.0761,
+     & 27.4511, 26.8399, 26.2424, 25.6581, 25.0869, 24.5283, 23.9823,
+     & 23.4483, 22.9263, 22.4159, 22.0109, 21.7266, 21.4461, 21.1691,
+     & 20.8957, 20.6259, 20.3595, 20.0966, 19.8371, 19.5809, 19.3281,
+     & 19.0785, 18.8321, 18.5889, 18.3489, 18.2124, 18.1771, 18.1420,
+     & 18.1069, 18.0719, 18.0369, 18.0021, 17.9672, 17.9325, 17.8978,
+     & 17.8632, 17.8287, 17.7942, 17.7598, 17.7254, 17.5766, 17.3366,
+     & 17.0999, 16.8665, 16.6362, 16.4091, 16.1851, 15.9641, 15.7461,
+     & 15.5312, 15.3191, 15.1100, 14.9037, 14.7002, 14.4995, 14.3561,
+     & 14.2503, 14.1453, 14.0410, 13.9375, 13.8347, 13.7327, 13.6315,
+     & 13.5310, 13.4313, 13.3323, 13.2340, 13.1364, 13.0396, 12.9435,
+     & 12.8549, 12.7705, 12.6867, 12.6035, 12.5208, 12.4387, 12.3570,
+     & 12.2760, 12.1954, 12.1154, 12.0359, 11.9569, 11.8785, 11.8006,
+     & 11.7231, 11.6697, 11.6266, 11.5836, 11.5408, 11.4982, 11.4557,
+     & 11.4133, 11.3712, 11.3291, 11.2873, 11.2456, 11.2040, 11.1626,
+     & 11.1213, 11.0803, 11.0412, 11.0029, 10.9648, 10.9268, 10.8889,
+     & 10.8512, 10.8136, 10.7761, 10.7387, 10.7015, 10.6644, 10.6274,
+     & 10.5906, 10.5539, 10.5173, 10.4062, 10.2779, 10.1512, 10.0261,
+     &  9.9025,  9.7804,  9.6598,  9.5407,  9.4231,  9.3070,  9.1922,
+     &  9.0789,  8.9670,  8.8564,  8.7473,  8.6658,  8.5898,  8.5144,
+     &  8.4397,  8.3656,  8.2922,  8.2194,  8.1473,  8.0758,  8.0049,
+     &  7.9346,  7.8650,  7.7960,  7.7276,  7.6597,  7.6149,  7.5728,
+     &  7.5309,  7.4892,  7.4478,  7.4066,  7.3656,  7.3249,  7.2844,
+     &  7.2441,  7.2040,  7.1642,  7.1246,  7.0851,  7.0460,  7.0194,
+     &  6.9935,  6.9678,  6.9421,  6.9165,  6.8911,  6.8657,  6.8404,
+     &  6.8152,  6.7901,  6.7651,  6.7402,  6.7154,  6.6906,  6.6660,
+     &  5.7876,  5.4343,  5.1027,  4.7912,  4.4988,  4.2242,  3.9664,
+     &  3.7243,  3.4970,  3.2836,  3.0832,  2.8950,  2.7183,  2.5524,
+     &  2.3966,  2.2504,  2.1130,  1.9841,  1.8630,  1.7493,  1.6425,
+     &  1.5422,  1.4481,  1.3597,  1.2767,  1.1988,  1.1257,  1.0570,
+     &  0.9924,  0.9319,  0.8750,  0.8216,  0.7715,  0.7244,  0.6802,
+     &  0.6386,  0.5997,  0.5631,  0.5287,  0.4964,  0.4661,  0.4377,
+     &  0.4110,  0.3859,  0.3623,  0.3402,  0.3195,  0.3000,  0.2817,
+     &  0.2645,  0.2483,  0.2332,  0.2189,  0.2056,  0.1930,  0.1812,
+     &  0.1702,  0.1598,  0.1500,  0.1409,  0.1323,  0.1242,  0.1166,
+     &  0.1095,  0.1028,  0.0966,  0.0907,  0.0851,  0.0799,  0.0751,
+     &  0.0705,  0.0662,  0.0621,  0.0583,  0.0548,  0.0514,  0.0483,
+     &  0.0453,  0.0426,  0.0400,  0.0375,  0.0353,  0.0331,  0.0311,
+     &  0.0292,  0.0274,  0.0257,  0.0242,  0.0227,  0.0213,  0.0200/
+
+        data XN/
+     &  1.9168,  1.9212,  1.9258,  1.9306,  1.9353,  1.9397,  1.9428,
+     &  1.9421,  1.9430,  1.9444,  1.9454,  1.9469,  1.9476,  1.9474,
+     &  1.9463,  1.9439,  1.9387,  1.9312,  1.9260,  1.9210,  1.9160,
+     &  1.9101,  1.9037,  1.8982,  1.8931,  1.8894,  1.8856,  1.8818,
+     &  1.8779,  1.8738,  1.8693,  1.8646,  1.8593,  1.8530,  1.8475,
+     &  1.8423,  1.8369,  1.8314,  1.8247,  1.8189,  1.8149,  1.8112,
+     &  1.8076,  1.8040,  1.8003,  1.7964,  1.7930,  1.7901,  1.7874,
+     &  1.7849,  1.7826,  1.7805,  1.7785,  1.7768,  1.7745,  1.7715,
+     &  1.7688,  1.7652,  1.7613,  1.7574,  1.7535,  1.7490,  1.7442,
+     &  1.7399,  1.7363,  1.7337,  1.7317,  1.7308,  1.7283,  1.7248,
+     &  1.7198,  1.7164,  1.7132,  1.7066,  1.7027,  1.7001,  1.6959,
+     &  1.6923,  1.6897,  1.6877,  1.6859,  1.6847,  1.6840,  1.6835,
+     &  1.6831,  1.6839,  1.6875,  1.6914,  1.6930,  1.6934,  1.6951,
+     &  1.6949,  1.6925,  1.6932,  1.6943,  1.6962,  1.6976,  1.6983,
+     &  1.6997,  1.7005,  1.7008,  1.7012,  1.7018,  1.7024,  1.7028,
+     &  1.7032,  1.7037,  1.7044,  1.7051,  1.7055,  1.7058,  1.7061,
+     &  1.7066,  1.7064,  1.7044,  1.7014,  1.7018,  1.7014,  1.7019,
+     &  1.7027,  1.7029,  1.7060,  1.7076,  1.7074,  1.7083,  1.7091,
+     &  1.7106,  1.7116,  1.7096,  1.7104,  1.7114,  1.7112,  1.7114,
+     &  1.7120,  1.7116,  1.7121,  1.7144,  1.7165,  1.7159,  1.7126,
+     &  1.7098,  1.7112,  1.7108,  1.7105,  1.7115,  1.7117,  1.7119,
+     &  1.7121,  1.7121,  1.7121,  1.7121,  1.7120,  1.7120,  1.7119,
+     &  1.7118,  1.7117,  1.7117,  1.7116,  1.7116,  1.7116,  1.7118,
+     &  1.7121,  1.7127,  1.7135,  1.7152,  1.7170,  1.7164,  1.7131,
+     &  1.7127,  1.7140,  1.7158,  1.7193,  1.7226,  1.7255,  1.7276,
+     &  1.7285,  1.7293,  1.7297,  1.7298,  1.7295,  1.7285,  1.7270,
+     &  1.7243,  1.7193,  1.7132,  1.7094,  1.7064,  1.7033,  1.7016,
+     &  1.7010,  1.7015,  1.7032,  1.7037,  1.7040,  1.7040,  1.7039,
+     &  1.7037,  1.7035,  1.7032,  1.7029,  1.7026,  1.7023,  1.7019,
+     &  1.7015,  1.7013,  1.7011,  1.7009,  1.7008,  1.7006,  1.7003,
+     &  1.6998,  1.6992,  1.6986,  1.6977,  1.6964,  1.6955,  1.6949,
+     &  1.6944,  1.6940,  1.6936,  1.6933,  1.6930,  1.6927,  1.6925,
+     &  1.6923,  1.6922,  1.6921,  1.6920,  1.6919,  1.6918,  1.6918,
+     &  1.6917,  1.6917,  1.6917,  1.6918,  1.6921,  1.6926,  1.6933,
+     &  1.6942,  1.6953,  1.6966,  1.6981,  1.6999,  1.7020,  1.7048,
+     &  1.7082,  1.7107,  1.7131,  1.7153,  1.7171,  1.7187,  1.7204,
+     &  1.7221,  1.7240,  1.7259,  1.7278,  1.7312,  1.7359,  1.7411,
+     &  1.7464,  1.7494,  1.7514,  1.7526,  1.7522,  1.7499,  1.7421,
+     &  1.7382,  1.7424,  1.7539,  1.7647,  1.7797,  1.8034,  1.7889,
+     &  1.7552,  1.7328,  1.7341,  1.7439,  1.7669,  1.7864,  1.7968,
+     &  1.8076,  1.8169,  1.8204,  1.8160,  1.7935,  1.7718,  1.7534,
+     &  1.7302,  1.6941,  1.6947,  1.7192,  1.7730,  1.8033,  1.7930,
+     &  1.4623,  1.5506,  1.5865,  1.6135,  1.6100,  1.6293,  1.6393,
+     &  1.6479,  1.6500,  1.6500,  1.6229,  1.5865,  1.5951,  1.6102,
+     &  1.6200,  1.6279,  1.6300,  1.6300,  1.6320,  1.6400,  1.6400,
+     &  1.6400,  1.6400,  1.6400,  1.6447,  1.6496,  1.6500,  1.6500,
+     &  1.6515,  1.6557,  1.6599,  1.6651,  1.6704,  1.6758,  1.6813,
+     &  1.6875,  1.6938,  1.7001,  1.7053,  1.7105,  1.7157,  1.7149,
+     &  1.6874,  1.6587,  1.6376,  1.6349,  1.6442,  1.6568,  1.6684,
+     &  1.6796,  1.6800,  1.6777,  1.6711,  1.6645,  1.6590,  1.6556,
+     &  1.6523,  1.6557,  1.6731,  1.6906,  1.7102,  1.7323,  1.7500,
+     &  1.7189,  1.6778,  1.6211,  1.5510,  1.4599,  1.3682,  1.2730,
+     &  1.1930,  1.1130,  1.0330,  0.9586,  0.9234,  0.8881,  0.8528,
+     &  0.8176,  0.8053,  0.8083,  0.8189,  0.8295,  0.8401,  0.8507,
+     &  0.8614,  0.8721,  0.8829,  0.8936,  0.9044,  0.9151,  0.9200/
+
+        data XK/
+     &.139E-01,.173E-01,.214E-01,.266E-01,.330E-01,.409E-01,.507E-01,
+     &.601E-01,.676E-01,.759E-01,.810E-01,.869E-01,.942E-01,.102E+00,
+     &.111E+00,.120E+00,.130E+00,.135E+00,.140E+00,.145E+00,.150E+00,
+     &.155E+00,.159E+00,.162E+00,.165E+00,.167E+00,.170E+00,.172E+00,
+     &.174E+00,.177E+00,.180E+00,.182E+00,.185E+00,.186E+00,.187E+00,
+     &.188E+00,.188E+00,.189E+00,.190E+00,.188E+00,.187E+00,.186E+00,
+     &.185E+00,.184E+00,.183E+00,.181E+00,.179E+00,.177E+00,.175E+00,
+     &.173E+00,.171E+00,.169E+00,.167E+00,.165E+00,.163E+00,.158E+00,
+     &.156E+00,.154E+00,.152E+00,.150E+00,.148E+00,.146E+00,.143E+00,
+     &.140E+00,.137E+00,.133E+00,.130E+00,.128E+00,.128E+00,.127E+00,
+     &.126E+00,.123E+00,.123E+00,.120E+00,.115E+00,.112E+00,.109E+00,
+     &.104E+00,.989E-01,.939E-01,.890E-01,.841E-01,.792E-01,.747E-01,
+     &.695E-01,.627E-01,.571E-01,.552E-01,.546E-01,.528E-01,.513E-01,
+     &.523E-01,.488E-01,.452E-01,.423E-01,.401E-01,.391E-01,.376E-01,
+     &.363E-01,.356E-01,.351E-01,.347E-01,.342E-01,.341E-01,.340E-01,
+     &.337E-01,.334E-01,.332E-01,.335E-01,.338E-01,.342E-01,.344E-01,
+     &.351E-01,.362E-01,.379E-01,.356E-01,.333E-01,.322E-01,.300E-01,
+     &.294E-01,.270E-01,.258E-01,.271E-01,.273E-01,.267E-01,.268E-01,
+     &.265E-01,.289E-01,.288E-01,.274E-01,.280E-01,.285E-01,.282E-01,
+     &.286E-01,.287E-01,.274E-01,.273E-01,.296E-01,.334E-01,.351E-01,
+     &.327E-01,.311E-01,.319E-01,.301E-01,.300E-01,.300E-01,.302E-01,
+     &.304E-01,.307E-01,.309E-01,.310E-01,.311E-01,.311E-01,.312E-01,
+     &.312E-01,.312E-01,.312E-01,.311E-01,.311E-01,.309E-01,.305E-01,
+     &.302E-01,.299E-01,.296E-01,.292E-01,.316E-01,.345E-01,.344E-01,
+     &.322E-01,.304E-01,.293E-01,.286E-01,.305E-01,.326E-01,.355E-01,
+     &.378E-01,.403E-01,.430E-01,.461E-01,.493E-01,.528E-01,.565E-01,
+     &.604E-01,.646E-01,.636E-01,.621E-01,.607E-01,.587E-01,.556E-01,
+     &.528E-01,.503E-01,.494E-01,.495E-01,.496E-01,.496E-01,.497E-01,
+     &.498E-01,.499E-01,.499E-01,.500E-01,.501E-01,.501E-01,.502E-01,
+     &.503E-01,.503E-01,.504E-01,.504E-01,.506E-01,.509E-01,.512E-01,
+     &.515E-01,.518E-01,.521E-01,.525E-01,.522E-01,.516E-01,.510E-01,
+     &.504E-01,.498E-01,.493E-01,.488E-01,.483E-01,.477E-01,.472E-01,
+     &.467E-01,.462E-01,.457E-01,.453E-01,.448E-01,.443E-01,.438E-01,
+     &.434E-01,.429E-01,.424E-01,.411E-01,.395E-01,.380E-01,.365E-01,
+     &.351E-01,.338E-01,.324E-01,.312E-01,.300E-01,.288E-01,.277E-01,
+     &.281E-01,.289E-01,.297E-01,.305E-01,.311E-01,.317E-01,.323E-01,
+     &.329E-01,.336E-01,.342E-01,.342E-01,.337E-01,.348E-01,.365E-01,
+     &.415E-01,.475E-01,.529E-01,.589E-01,.656E-01,.705E-01,.744E-01,
+     &.645E-01,.558E-01,.515E-01,.532E-01,.550E-01,.806E-01,.121E+00,
+     &.139E+00,.112E+00,.921E-01,.777E-01,.696E-01,.819E-01,.914E-01,
+     &.102E+00,.121E+00,.145E+00,.173E+00,.199E+00,.204E+00,.208E+00,
+     &.213E+00,.190E+00,.147E+00,.114E+00,.111E+00,.157E+00,.220E+00,
+     &.428E-01,.109E-01,.807E-02,.141E-01,.147E-01,.100E-01,.128E-01,
+     &.190E-01,.321E-01,.252E-01,.273E-01,.124E-01,.719E-02,.719E-02,
+     &.719E-02,.719E-02,.719E-02,.719E-02,.719E-02,.719E-02,.719E-02,
+     &.718E-02,.709E-02,.701E-02,.720E-02,.699E-02,.759E-02,.723E-02,
+     &.694E-02,.723E-02,.777E-02,.864E-02,.102E-01,.126E-01,.160E-01,
+     &.204E-01,.264E-01,.346E-01,.435E-01,.551E-01,.701E-01,.889E-01,
+     &.109E+00,.129E+00,.147E+00,.168E+00,.188E+00,.205E+00,.226E+00,
+     &.250E+00,.275E+00,.294E+00,.299E+00,.303E+00,.309E+00,.318E+00,
+     &.328E+00,.339E+00,.353E+00,.368E+00,.407E+00,.484E+00,.584E+00,
+     &.698E+00,.788E+00,.873E+00,.950E+00,.101E+01,.107E+01,.104E+01,
+     &.988E+00,.942E+00,.899E+00,.850E+00,.758E+00,.676E+00,.603E+00,
+     &.538E+00,.461E+00,.389E+00,.326E+00,.274E+00,.230E+00,.193E+00,
+     &.164E+00,.140E+00,.119E+00,.101E+00,.861E-01,.733E-01,.681E-01/
+
+      XNR=XN(1)
+      XNI=XK(1)
+      WAVELN = WLNMETERS !* 1.E6  ! ARRAYS ARE IN MICRONS
+      IF (WAVELN .GE. W(1))  RETURN
+      XNR=XN(385)
+      XNI=XK(385)
+      IF (WAVELN .LE. W(385)) RETURN
+      DO 100 I=2,384
+      IF (WAVELN .GT. W(I) ) GOTO 101
+ 100  CONTINUE
+ 101  CONTINUE
+C ALL INTERPOLATION IS IN LOG LAMBDA 
+      FACTOR= (alog(WAVELN) - alog(W(I)) ) / (alog(W(I-1)) - alog(W(I)))
+C REAL PART IS LINEARLY INTERPOLATED
+      XNR=XN(I) + FACTOR*(XN(I-1) - XN(I))
+C IMAGINARY PART IS LOG INTERPOLATED
+      XNI=alog(XK(I)) + FACTOR*(alog(XK(I-1)) - alog(XK(I)))
+      XNI=exp(XNI)
+
+      RETURN
+      END
+
+
Index: trunk/LMDZ.TITAN/libf/phytitan/titan_for.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/titan_for.h	(revision 1055)
+++ 	(revision )
@@ -1,19 +1,0 @@
-c Include titan_for.h
-c---------------------
-
-      INTEGER NLEV ! Nombre de niveaux verticaux
-
-      INTEGER NC ! Nombre de composes chimiques
-
-      INTEGER ND ! Nombre de photodissociations
-      INTEGER NR ! Nombre de reactions
-
-c Doivent etre en accord avec titan.h !!!!!!!
-
-      PARAMETER (NLEV=55) 
-      
-      PARAMETER (NC=44) 
-      
-      PARAMETER (ND=54)
-      PARAMETER (NR=377) 
-
Index: trunk/LMDZ.TITAN/libf/phytitan/wind_scal.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/wind_scal.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/wind_scal.F	(revision 1056)
@@ -0,0 +1,55 @@
+      SUBROUTINE wind_scal(pbaru,pbarv,us,vs)
+c=======================================================================
+c
+c
+c   Subject:
+c   ------
+c   On ramene les flux de masse /vents  aux points scalaires.
+c
+c=======================================================================
+      IMPLICIT NONE
+c-----------------------------------------------------------------------
+c   Declararations:
+c   ---------------
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comgeom.h"
+
+c   Arguments:
+c   ----------
+
+      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
+      REAL us(ip1jmp1,llm), vs (ip1jmp1,llm)
+
+c   Local:
+c   ------
+
+      INTEGER ij,l
+
+c-----------------------------------------------------------------------
+
+c   transport zonal:
+c   ----------------
+      DO l=1,llm
+	 DO ij=2,ip1jmp1
+            us(ij,l)=.5*(pbaru(ij,l)+pbaru(ij-1,l))
+	 ENDDO
+      ENDDO
+      CALL SCOPY(jjp1*llm,us(iip1,1),iip1,us(1,1),iip1)
+
+
+c   Transport meridien:
+c   -------------------
+      DO l=1,llm
+         DO ij=iip2,ip1jm
+	    vs(ij,l)=.5*(pbarv(ij,l)+pbarv(ij-iip1,l))
+	 ENDDO
+	 DO ij=1,iip1
+	    vs(ij,l)=0.
+	    vs(ip1jm+ij,l)=0.
+	 ENDDO
+      ENDDO
+
+      RETURN
+      END
Index: trunk/LMDZ.TITAN/libf/phytitan/write_archive.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/write_archive.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/write_archive.F	(revision 1056)
@@ -0,0 +1,197 @@
+c=======================================================================
+      subroutine write_archive(nid,nom,titre,unite,dim,px)
+c=======================================================================
+c
+c
+c   Date:    01/1997
+c   ----
+c
+c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
+c   -----    dans un fichier DRS nomme "start_archive"
+c
+c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
+c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
+c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
+c    (ex: la longitude solaire)
+c
+c
+c   Arguments: 
+c   ----------
+c
+c     Inputs:
+c     ------
+c
+c		  nid      Unite logique du fichier "start_archive"
+c         nom      nom du champ a ecrire dans le fichier "start_archive"
+c         titre    titre de la variable dans le fichier DRS "start_archive"
+c         unite    unite de la variable ....
+c         dim      dimension de la variable a ecrire
+c         px       tableau contenant la variable a ecrire
+c
+c
+c=======================================================================
+
+      USE control_mod
+
+      implicit none
+
+#include "dimensions.h"
+#include "paramet.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "description.h"
+#include "temps.h"
+#include "netcdf.inc"
+
+c-----------------------------------------------------------------------
+c	Declarations   
+c-----------------------------------------------------------------------
+
+c Arguments:
+
+      INTEGER nid,ntime,dim 
+      REAL px(iip1,jjp1,llm) 
+
+      CHARACTER*(*) nom, titre, unite
+
+      integer ierr
+
+
+c local
+      integer, dimension(4) :: edges,corner,id
+      integer :: varid,i,j,l
+
+      ntime = 1
+      
+c-----------------------------------------------------------------------
+c      Ecriture du champs dans le fichier            (3 cas)      
+c-----------------------------------------------------------------------
+
+!Cas Variable 3D
+!---------------
+        if (dim.eq.3) then
+
+!         Ecriture du champs
+
+! nom de la variable
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+! choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"rlonv",id(1))
+              ierr= NF_INQ_DIMID(nid,"rlatu",id(2))
+              ierr= NF_INQ_DIMID(nid,"sigs",id(3))
+              ierr= NF_INQ_DIMID(nid,"Time",id(4))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=1
+           corner(4)=ntime
+
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=llm
+           edges(4)=1
+#ifdef NC_DOUBLE
+           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
+              call abort
+           endif
+
+!Cas Variable 2D
+!---------------
+
+        else if (dim.eq.2) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"rlonv",id(1))
+              ierr= NF_INQ_DIMID(nid,"rlatu",id(2))
+              ierr= NF_INQ_DIMID(nid,"Time",id(3))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
+
+           endif
+
+           corner(1)=1
+           corner(2)=1
+           corner(3)=ntime
+           edges(1)=iip1
+           edges(2)=jjp1
+           edges(3)=1
+
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else         
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif     
+
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+
+!Cas Variable 0D (scalaire dependant du temps)
+!---------------------------------------------
+
+        else if (dim.eq.0) then
+
+!         Ecriture du champs
+
+           ierr= NF_INQ_VARID(nid,nom,varid)
+           if (ierr /= NF_NOERR) then
+!  choix du nom des coordonnees
+              ierr= NF_INQ_DIMID(nid,"temps",id(1))
+
+! Creation de la variable si elle n'existait pas
+
+              write (*,*) "====================="
+              write (*,*) "creation de ",nom
+
+              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
+
+           endif
+
+           corner(1)=ntime
+           edges(1)=1
+
+#ifdef NC_DOUBLE
+           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
+#else
+           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
+#endif
+           if (ierr.ne.NF_NOERR) then
+              write(*,*) "***** PUT_VAR matter in write_archive"
+              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
+              call abort
+           endif
+
+        endif
+
+      return
+      end
+
Index: trunk/LMDZ.TITAN/libf/phytitan/write_field_phy.F90
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/write_field_phy.F90	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/write_field_phy.F90	(revision 1056)
@@ -0,0 +1,36 @@
+!
+! $Header$
+!
+MODULE write_field_phy
+
+  CONTAINS 
+ 
+    SUBROUTINE WriteField_phy(name,Field,ll)
+    USE dimphy
+    USE mod_phys_lmdz_para
+    USE mod_grid_phy_lmdz
+    USE Write_Field
+    
+    IMPLICIT NONE
+    include 'dimensions.h'
+    include 'paramet.h'
+
+    character(len=*)   :: name
+    INTEGER :: ll
+    real, dimension(klon_omp,ll) :: Field
+    real,save,allocatable :: Field_tmp(:,:)
+    real, dimension(klon_glo,ll):: New_Field
+    real, dimension(iim,jjp1,ll):: Field_2d
+
+    CALL Gather(Field,New_Field)
+!$OMP MASTER
+    IF (is_mpi_root) THEN	
+      CALL Grid1Dto2D_glo(New_Field,Field_2D)
+      CALL WriteField(name,Field_2d)
+    ENDIF
+!$OMP END MASTER
+
+  
+   END SUBROUTINE WriteField_phy
+ 
+ END MODULE write_field_phy
Index: trunk/LMDZ.TITAN/libf/phytitan/write_histday.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/write_histday.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/write_histday.h	(revision 1056)
@@ -3,120 +3,72 @@
 !
       IF (ok_journe) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-      zx_tmp_2d = 0.
-      zx_tmp_3d = 0.
-      zx_tmp_fi2d=0.
-      zx_tmp_fi3d=0.
-c
+
          zsto = dtime
-         zout = dtime * FLOAT(ecrit_day)
+         zout = dtime * REAL(ecrit_day)
          itau_w = itau_phy + itap
 
-c
 c-------------------------------------------------------
       IF(lev_histday.GE.1) THEN
-c
+
 ccccccccccccc 2D fields, invariables
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-      CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
-      CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_day,.false.,"phis",itau_w,pphis)
+      call histwrite_phy(nid_day,.false.,"aire",itau_w,airephy)
+
 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
-      do j=1,jjmp1
-       do i=1,iim
-        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
-       enddo
-      enddo
-c Correction passage de 360 à 0... Sinon probleme avec moyenne
+c Correction passage de 360 a 0... Sinon probleme avec moyenne
       if (zls.lt.zlsm1) then
-        zx_tmp_2d = zx_tmp_2d+360.
+        do i=1,klon
+          tmpout(i,1) = zls*180./RPI+360.
+        enddo
         zlsm1 = 2.*RPI
       else
+        do i=1,klon
+          tmpout(i,1) = zls*180./RPI
+        enddo
         zlsm1 = zls
       endif
-      CALL histwrite(nid_day,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+      call histwrite_phy(nid_day,.false.,"ls",itau_w,tmpout(:,1))
+
 ccccccccccccc 2D fields, variables
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
-      CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
-c     CALL histwrite(nid_day,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
-c     CALL histwrite(nid_day,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_day,.false.,"tsol",itau_w,ftsol)
+      call histwrite_phy(nid_day,.false.,"psol",itau_w,paprs(:,1))
+
+c     call histwrite_phy(nid_day,.false.,"ue",itau_w,ue)
+c     call histwrite_phy(nid_day,.false.,"ve",itau_w,ve)
+
       ENDIF !lev_histday.GE.1
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.2) THEN
-c
+
 ccccccccccccc 3D fields, basics
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
-      CALL histwrite(nid_day,"dudyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-      CALL histwrite(nid_day,"duvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+
+      call histwrite_phy(nid_day,.false.,"temp",itau_w,t_seri)
+      call histwrite_phy(nid_day,.false.,"pres",itau_w,pplay)
+      call histwrite_phy(nid_day,.false.,"geop",itau_w,zphi)
+      call histwrite_phy(nid_day,.false.,"vitu",itau_w,u_seri)
+      call histwrite_phy(nid_day,.false.,"vitv",itau_w,v_seri)
+      call histwrite_phy(nid_day,.false.,"vitw",itau_w,omega)
+      call histwrite_phy(nid_day,.false.,"tops",itau_w,topsw)
+      call histwrite_phy(nid_day,.false.,"duvdf",itau_w,d_u_vdf)
+      call histwrite_phy(nid_day,.false.,"dudyn",itau_w,d_u_dyn)
+
 cccccccccccccccccc  Tracers
-c
+
          if (iflag_trac.eq.1) THEN
           if (microfi.ge.1) then
-c           DO iq=1,nmicro
-c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
-c      CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d,
-c     .                                   iim*jjmp1*klev,ndex3d)
-c           ENDDO
+c          DO iq=1,nmicro
+c      call histwrite_phy(nid_day,.false.,tname(iq),
+c    .                    itau_w,qaer(1:klon,1:klev,iq))
+c          ENDDO
 c    -------   NB AER TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_day,"qaer",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,1:nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_day,.false.,"qaer",itau_w,tmpout)
 
              if (clouds.eq.1) then
@@ -124,140 +76,116 @@
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_day,"qnoy",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_day,.false.,"qnoy",itau_w,tmpout)
 c    -------   V GLA1 TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_day,"qgl1",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_day,.false.,"qgl1",itau_w,tmpout)
 c    -------   V GLA2 TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_day,"qgl2",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_day,.false.,"qgl2",itau_w,tmpout)
 c    -------   V GLA3 TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_day,"qgl3",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_day,.false.,"qgl3",itau_w,tmpout)
 c --------------
 c ----- SATURATION ESP NUAGES
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d)
-       CALL histwrite(nid_day,"ch4sat", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d)
-       CALL histwrite(nid_day,"c2h6sat", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d)
-       CALL histwrite(nid_day,"c2h2sat", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_day,.false.,"ch4sat",itau_w,satch4)
+       call histwrite_phy(nid_day,.false.,"c2h6sat",itau_w,satc2h6)
+       call histwrite_phy(nid_day,.false.,"c2h2sat",itau_w,satc2h2)
 c --------------
 c ----- RESERVOIR DE SURFACE
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d)
-       CALL histwrite(nid_day,"reserv",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_day,.false.,"reserv",itau_w,reservoir)
 c --------------
 c ----- ECHANGE GAZ SURF/ATM (evaporation)
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,evapch4,zx_tmp_2d)
-       CALL histwrite(nid_day,"evapch4",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_day,.false.,"evapch4",itau_w,evapch4)
 c --------------
 c ----- PRECIPITATIONS
 c       -----  CH4
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d)
-       CALL histwrite(nid_day,"prech4",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_day,.false.,"prech4",
+     .            itau_w,precip(1:klon,1))
 c       -----  C2H6
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d)
-       CALL histwrite(nid_day,"prec2h6",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_day,.false.,"prec2h6",
+     .            itau_w,precip(1:klon,2))
 c       -----  C2H2
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d)
-       CALL histwrite(nid_day,"prec2h2",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
-c
+       call histwrite_phy(nid_day,.false.,"prec2h2",
+     .            itau_w,precip(1:klon,3))
+c       -----  NOY
+       call histwrite_phy(nid_day,.false.,"prenoy",
+     .            itau_w,precip(1:klon,4))
+c       -----  AER
+       call histwrite_phy(nid_day,.false.,"preaer",
+     .            itau_w,precip(1:klon,5))
 c --------------
 c ----- FLUX GLACE
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .              flxesp_i(1:klon,1:klev,1),zx_tmp_3d)
-       CALL histwrite(nid_day,"flxgl1", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .              flxesp_i(1:klon,1:klev,2),zx_tmp_3d)
-       CALL histwrite(nid_day,"flxgl2", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .              flxesp_i(1:klon,1:klev,3),zx_tmp_3d)
-       CALL histwrite(nid_day,"flxgl3", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+c       -----  CH4
+       call histwrite_phy(nid_day,.false.,"flxgl1",
+     .            itau_w,flxesp_i(1:klon,1:klev,1))
+c       -----  C2H6
+       call histwrite_phy(nid_day,.false.,"flxgl2",
+     .            itau_w,flxesp_i(1:klon,1:klev,2))
+c       -----  C2H2
+       call histwrite_phy(nid_day,.false.,"flxgl3",
+     .            itau_w,flxesp_i(1:klon,1:klev,3))
+c --------------
+c ----- Source/puits GLACE
+c       -----  CH4
+       call histwrite_phy(nid_day,.false.,"solch4",
+     .            itau_w,solesp(1:klon,1:klev,1))
+c       -----  C2H6
+       call histwrite_phy(nid_day,.false.,"solc2h6",
+     .            itau_w,solesp(1:klon,1:klev,2))
+c       -----  C2H2
+       call histwrite_phy(nid_day,.false.,"solc2h2",
+     .            itau_w,solesp(1:klon,1:klev,3))
 c --------------
 c ----- RAYON MOYEN GOUTTE
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d)
-       CALL histwrite(nid_day,"rcldbar", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+       call histwrite_phy(nid_day,.false.,"rcldbar",itau_w,rmcloud)
+
              endif
 	  endif
-c
+
 c --------------
 c ----- TRACEURS CHIMIQUES
 	  if (nmicro.lt.nqmax) then
            DO iq=nmicro+1,nqmax
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
-       CALL histwrite(nid_day,tname(iq),itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_day,.false.,tname(iq),
+     .                    itau_w,tr_seri(1:klon,1:klev,iq))
            ENDDO
 	  endif
          endif
-c
+
       ENDIF !lev_histday.GE.2
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.3) THEN
-c
+
 cccccccccccccccccc  Radiative transfer
-c
+
 c 2D
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_day,.false.,"topl",itau_w,toplw)
+      call histwrite_phy(nid_day,.false.,"sols",itau_w,solsw)
+      call histwrite_phy(nid_day,.false.,"soll",itau_w,sollw)
+
 c 3D
-c
-      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"SWnet",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"LWnet",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+
+      call histwrite_phy(nid_day,.false.,"SWnet",
+     .          itau_w,swnet(1:klon,1:klev))
+      call histwrite_phy(nid_day,.false.,"LWnet",
+     .          itau_w,lwnet(1:klon,1:klev))
+
 c --------------
 c ----- OPACITE BRUME
@@ -268,9 +196,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"thv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"thv"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECV 
 
@@ -281,11 +206,7 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"thi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"thi"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECI 
-c
 c --------------
 c ----- EXTINCTION BRUME
@@ -302,9 +223,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"khv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"khv"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECV 
 
@@ -321,11 +239,7 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"khi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"khi"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECI 
-c
 c --------------
 c ----- OPACITE GAZ
@@ -336,9 +250,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"tgv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"tgv"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECV 
 
@@ -349,11 +260,7 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"tgi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"tgi"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECI 
-c
 c --------------
 c ----- EXTINCTION GAZ
@@ -370,9 +277,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"kgv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"kgv"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECV 
 
@@ -390,18 +294,13 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"kgi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_day,.false.,"kgi"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECI 
 
 c --------------
+         if (clouds.eq.1) then
+c --------------
 c ----- OPACITE NUAGES (ATTENTION PROXY)
-         if (clouds.eq.1) then
-           zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev)
-           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-           CALL histwrite(nid_day,"tcld",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         call histwrite_phy(nid_day,.false.,"tcld",itau_w,occcld)
 c --------------
 c ----- EXTINCTION NUAGES (ATTENTION PROXY)
@@ -414,74 +313,40 @@
              enddo
            enddo
-           zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev)
-           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-           CALL histwrite(nid_day,"kcld",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         call histwrite_phy(nid_day,.false.,"kcld",itau_w,t_kcld)
+c --------------
         endif  
-c
+c --------------
+
       ENDIF !lev_histday.GE.3
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.4) THEN
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite(nid_day,"dtdyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
-      CALL histwrite(nid_day,"dtphy",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+
+      call histwrite_phy(nid_day,.false.,"dtdyn",itau_w,d_t_dyn)
+      call histwrite_phy(nid_day,.false.,"dtphy",itau_w,d_t)
 c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"dtvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+      call histwrite_phy(nid_day,.false.,"dtvdf",itau_w,d_t_vdf)
 c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"dtajs",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+      call histwrite_phy(nid_day,.false.,"dtajs",itau_w,d_t_ajs)
 c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"dtswr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+      call histwrite_phy(nid_day,.false.,"dtswr",itau_w,heat)
+c K/s
+      call histwrite_phy(nid_day,.false.,"dtlwr",itau_w,-1.*cool)
 c K/s      
-      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_day,"dtlwr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c K/s      
-c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-c     CALL histwrite(nid_day,"dtec",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
+c      call histwrite_phy(nid_day,.false.,"dtec",itau_w,d_t_ec)
+
       ENDIF !lev_histday.GE.4
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.5) THEN
-c
-c
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
-c      CALL histwrite(nid_day,"taux_",itau_w,
-c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c      
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
-c      CALL histwrite(nid_day,"tauy_",itau_w,
-c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
-c     CALL histwrite(nid_day,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
-c     CALL histwrite(nid_day,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+c      call histwrite_phy(nid_day,.false.,"taux",itau_w,fluxu)
+c      call histwrite_phy(nid_day,.false.,"tauy",itau_w,fluxv)
+c      call histwrite_phy(nid_day,.false.,"cdrm",itau_w,cdragm)
+c      call histwrite_phy(nid_day,.false.,"cdrh",itau_w,cdragh)
+
       ENDIF !lev_histday.GE.5
 c-------------------------------------------------------
-c
+
       if (ok_sync) then
         call histsync(nid_day)
Index: trunk/LMDZ.TITAN/libf/phytitan/write_histins.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/write_histins.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/write_histins.h	(revision 1056)
@@ -3,144 +3,85 @@
 !
       IF (ok_instan) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-      zx_tmp_2d = 0.
-      zx_tmp_3d = 0.
-      zx_tmp_fi2d=0.
-      zx_tmp_fi3d=0.
-c
-          zsto = dtime * FLOAT(ecrit_ins)
-          zout = dtime * FLOAT(ecrit_ins)
+
+         zsto = dtime * REAL(ecrit_ins)
+         zout = dtime * REAL(ecrit_ins)
          itau_w = itau_phy + itap
 
-c
 c-------------------------------------------------------
       IF(lev_histday.GE.1) THEN
-c
+
 ccccccccccccc 2D fields, invariables
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-      CALL histwrite(nid_ins,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
-      CALL histwrite(nid_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_ins,.false.,"phis",itau_w,pphis)
+      call histwrite_phy(nid_ins,.false.,"aire",itau_w,airephy)
+
 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
-      do j=1,jjmp1
-       do i=1,iim
-        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
-       enddo
+      do i=1,klon
+        tmpout(i,1) = zls*180./RPI
       enddo
-      CALL histwrite(nid_ins,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+      call histwrite_phy(nid_ins,.false.,"ls",itau_w,tmpout(:,1))
+
 ccccccccccccc 2D fields, variables
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
-      CALL histwrite(nid_ins,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_ins,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
-c     CALL histwrite(nid_ins,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
-c     CALL histwrite(nid_ins,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_ins,.false.,"tsol",itau_w,ftsol)
+      call histwrite_phy(nid_ins,.false.,"psol",itau_w,paprs(:,1))
+
+c     call histwrite_phy(nid_ins,.false.,"ue",itau_w,ue)
+c     call histwrite_phy(nid_ins,.false.,"ve",itau_w,ve)
+
       ENDIF !lev_histday.GE.1
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.2) THEN
-c
+
 ccccccccccccc 3D fields, basics
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_ins,"temp",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_ins,"pres",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_ins,"geop",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_ins,"vitu",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_ins,"vitv",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_ins,"vitw",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_ins,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-c     CALL histwrite(nid_ins,"duvdf",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
-c     CALL histwrite(nid_ins,"dudyn",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
+
+      call histwrite_phy(nid_ins,.false.,"temp",itau_w,t_seri)
+      call histwrite_phy(nid_ins,.false.,"pres",itau_w,pplay)
+      call histwrite_phy(nid_ins,.false.,"geop",itau_w,zphi)
+      call histwrite_phy(nid_ins,.false.,"vitu",itau_w,u_seri)
+      call histwrite_phy(nid_ins,.false.,"vitv",itau_w,v_seri)
+      call histwrite_phy(nid_ins,.false.,"vitw",itau_w,omega)
+      call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw)
+c      call histwrite_phy(nid_ins,.false.,"duvdf",itau_w,d_u_vdf)
+c      call histwrite_phy(nid_ins,.false.,"dudyn",itau_w,d_u_dyn)
+
       ENDIF !lev_histday.GE.2
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.3) THEN
-c
+
 cccccccccccccccccc  Tracers
-c
+
          if (iflag_trac.eq.1) THEN
           if (microfi.eq.1) then
            DO iq=1,nmicro
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
-       CALL histwrite(nid_ins,tname(iq),itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_ins,.false.,tname(iq),
+     .                    itau_w,qaer(1:klon,1:klev,iq))
            ENDDO
 	  endif
 	  if (nmicro.lt.nqmax) then
            DO iq=nmicro+1,nqmax
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
-       CALL histwrite(nid_ins,tname(iq),itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_ins,.false.,tname(iq),
+     .                    itau_w,tr_seri(1:klon,1:klev,iq))
            ENDDO
 	  endif
          endif
-c
+
 cccccccccccccccccc  Radiative transfer
-c
+
 c 2D
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_ins,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_ins,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_ins,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_ins,.false.,"topl",itau_w,toplw)
+      call histwrite_phy(nid_ins,.false.,"sols",itau_w,solsw)
+      call histwrite_phy(nid_ins,.false.,"soll",itau_w,sollw)
+
 c 3D
-c
-      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"SWnet",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"LWnet",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+
+      call histwrite_phy(nid_ins,.false.,"SWnet",
+     .          itau_w,swnet(1:klon,1:klev))
+      call histwrite_phy(nid_ins,.false.,"LWnet",
+     .          itau_w,lwnet(1:klon,1:klev))
+
 c --------------
 c ----- OPACITE BRUME
@@ -151,9 +92,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"thv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"thv"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECV 
 
@@ -164,9 +102,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"thi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"thi"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECI 
 c --------------
@@ -178,5 +113,4 @@
      s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
      s                -TAUHVD(i,klev-l+1-1,k)
-
           if(l.eq.klev)
      s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
@@ -185,9 +119,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"khv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"khv"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECV 
 
@@ -198,5 +129,4 @@
      s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
      s                -TAUHID(i,klev-l+1-1,k)
-
           if(l.eq.klev)
      s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
@@ -205,9 +135,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"khi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"khi"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECI 
 c --------------
@@ -219,9 +146,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"tgv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"tgv"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECV 
 
@@ -232,9 +156,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"tgi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"tgi"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECI 
 c --------------
@@ -246,5 +167,4 @@
      s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
      s                -TAUGVD(i,klev-l+1-1,k)
-
           if(l.eq.klev)
      s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
@@ -253,9 +173,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"kgv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"kgv"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECV 
 
@@ -273,79 +190,40 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"kgi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_ins,.false.,"kgi"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECI 
 
       ENDIF !lev_histday.GE.3
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.4) THEN
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite(nid_ins,"dtdyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
-      CALL histwrite(nid_ins,"dtphy",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"dtajs",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"dtswr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+
+      call histwrite_phy(nid_ins,.false.,"dtdyn",itau_w,d_t_dyn)
+      call histwrite_phy(nid_ins,.false.,"dtphy",itau_w,d_t)
+c K/s
+      call histwrite_phy(nid_ins,.false.,"dtvdf",itau_w,d_t_vdf)
+c K/s
+      call histwrite_phy(nid_ins,.false.,"dtajs",itau_w,d_t_ajs)
+c K/s
+      call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,heat)
+c K/s
+      call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,-1.*cool)
 c K/s      
-      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_ins,"dtlwr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c K/s      
-c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-c     CALL histwrite(nid_ins,"dtec",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
-c     CALL histwrite(nid_ins,"dvvdf",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
+c      call histwrite_phy(nid_ins,.false.,"dtec",itau_w,d_t_ec)
+c      call histwrite_phy(nid_ins,.false.,"dvvdf",itau_w,d_v_vdf)
+
       ENDIF !lev_histday.GE.4
-c
+
 c-------------------------------------------------------
       IF(lev_histday.GE.5) THEN
-c
-c
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
-c      CALL histwrite(nid_ins,"taux_",itau_w,
-c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c      
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
-c      CALL histwrite(nid_ins,"tauy_",itau_w,
-c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
-c     CALL histwrite(nid_ins,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
-c     CALL histwrite(nid_ins,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+c      call histwrite_phy(nid_ins,.false.,"taux",itau_w,fluxu)
+c      call histwrite_phy(nid_ins,.false.,"tauy",itau_w,fluxv)
+c      call histwrite_phy(nid_ins,.false.,"cdrm",itau_w,cdragm)
+c      call histwrite_phy(nid_ins,.false.,"cdrh",itau_w,cdragh)
+
       ENDIF !lev_histday.GE.5
 c-------------------------------------------------------
-c
+
       if (ok_sync) then
         call histsync(nid_ins)
Index: trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h	(revision 1056)
@@ -1,121 +1,72 @@
       IF (ok_mensuel) THEN
-c
-      ndex2d = 0
-      ndex3d = 0
-      zx_tmp_2d = 0.
-      zx_tmp_3d = 0.
-      zx_tmp_fi2d=0.
-      zx_tmp_fi3d=0.
-c
+
          zsto = dtime
-         zout = dtime * FLOAT(ecrit_mth)
+         zout = dtime * REAL(ecrit_mth)
          itau_w = itau_phy + itap
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.1) THEN
-c
+
 ccccccccccccc 2D fields, invariables
-c
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
-      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-C
-      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
-      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_mth,.false.,"phis",itau_w,pphis)
+      call histwrite_phy(nid_mth,.false.,"aire",itau_w,airephy)
+
 ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
-      do j=1,jjmp1
-       do i=1,iim
-        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
-       enddo
-      enddo
-c Correction passage de 360 à 0... Sinon probleme avec moyenne
+c Correction passage de 360 a 0... Sinon probleme avec moyenne
       if (zls.lt.zlsm1) then
-        zx_tmp_2d = zx_tmp_2d+360.
+        do i=1,klon
+          tmpout(i,1) = zls*180./RPI+360.
+        enddo
         zlsm1 = 2.*RPI
       else
+        do i=1,klon
+          tmpout(i,1) = zls*180./RPI
+        enddo
         zlsm1 = zls
       endif
-      CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+      call histwrite_phy(nid_mth,.false.,"ls",itau_w,tmpout(:,1))
+
 ccccccccccccc 2D fields, variables
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      DO i = 1, klon
-         zx_tmp_fi2d(i) = paprs(i,1)
-      ENDDO
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
-      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
-c     CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
-c     CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
-c     CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
-c     CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_mth,.false.,"tsol",itau_w,ftsol)
+      call histwrite_phy(nid_mth,.false.,"psol",itau_w,paprs(:,1))
+
+c     call histwrite_phy(nid_mth,.false.,"ue",itau_w,ue)
+c     call histwrite_phy(nid_mth,.false.,"ve",itau_w,ve)
+
       ENDIF !lev_histmth.GE.1
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.2) THEN
-c
+
 ccccccccccccc 3D fields, basics
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
-      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
-      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
-      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
-c     CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_mth,.false.,"temp",itau_w,t_seri)
+      call histwrite_phy(nid_mth,.false.,"pres",itau_w,pplay)
+      call histwrite_phy(nid_mth,.false.,"geop",itau_w,zphi)
+      call histwrite_phy(nid_mth,.false.,"vitu",itau_w,u_seri)
+      call histwrite_phy(nid_mth,.false.,"vitv",itau_w,v_seri)
+      call histwrite_phy(nid_mth,.false.,"vitw",itau_w,omega)
+c      call histwrite_phy(nid_mth,.false.,"Kz",itau_w,ycoefh)
+      call histwrite_phy(nid_mth,.false.,"tops",itau_w,topsw)
+      call histwrite_phy(nid_mth,.false.,"duvdf",itau_w,d_u_vdf)
+      call histwrite_phy(nid_mth,.false.,"dudyn",itau_w,d_u_dyn)
+
 cccccccccccccccccc  Tracers
-c
+
          if (iflag_trac.eq.1) THEN
           if (microfi.ge.1) then
 c          DO iq=1,nmicro
-c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, 
-c    .                  qaer(1:klon,1:klev,iq), zx_tmp_3d)
-c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
+c      call histwrite_phy(nid_mth,.false.,tname(iq),
+c    .                    itau_w,qaer(1:klon,1:klev,iq))
 c          ENDDO
 c    -------   NB AER TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,1:nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_mth,"qaer",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,1:nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_mth,.false.,"qaer",itau_w,tmpout)
 
              if (clouds.eq.1) then
@@ -123,174 +74,121 @@
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_mth,"qnoy",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_mth,.false.,"qnoy",itau_w,tmpout)
 c    -------   V GLA1 TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_mth,"qgl1",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_mth,.false.,"qgl1",itau_w,tmpout)
 c    -------   V GLA2 TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_mth,"qgl2",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_mth,.false.,"qgl2",itau_w,tmpout)
 c    -------   V GLA3 TOT
                do i=1,klon
                  do j=1,klev
-                   zx_tmp_fi3d(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad))
-                 enddo
-               enddo
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-       CALL histwrite(nid_mth,"qgl3",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+                   tmpout(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad))
+                 enddo
+               enddo
+       call histwrite_phy(nid_mth,.false.,"qgl3",itau_w,tmpout)
 c --------------
 c ----- SATURATION ESP NUAGES
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satch4,zx_tmp_3d)
-       CALL histwrite(nid_mth,"ch4sat", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h6,zx_tmp_3d)
-       CALL histwrite(nid_mth,"c2h6sat", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, satc2h2,zx_tmp_3d)
-       CALL histwrite(nid_mth,"c2h2sat", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,"ch4sat",itau_w,satch4)
+       call histwrite_phy(nid_mth,.false.,"c2h6sat",itau_w,satc2h6)
+       call histwrite_phy(nid_mth,.false.,"c2h2sat",itau_w,satc2h2)
 c --------------
 c ----- RESERVOIR DE SURFACE
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,reservoir,zx_tmp_2d)
-       CALL histwrite(nid_mth,"reserv",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_mth,.false.,"reserv",itau_w,reservoir)
 c --------------
 c ----- ECHANGE GAZ SURF/ATM (evaporation)
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,evapch4,zx_tmp_2d)
-       CALL histwrite(nid_mth,"evapch4",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_mth,.false.,"evapch4",itau_w,evapch4)
 c --------------
 c ----- PRECIPITATIONS
 c       -----  CH4
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,1),zx_tmp_2d)
-       CALL histwrite(nid_mth,"prech4",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_mth,.false.,"prech4",
+     .            itau_w,precip(1:klon,1))
 c       -----  C2H6
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,2),zx_tmp_2d)
-       CALL histwrite(nid_mth,"prec2h6",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_mth,.false.,"prec2h6",
+     .            itau_w,precip(1:klon,2))
 c       -----  C2H2
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,3),zx_tmp_2d)
-       CALL histwrite(nid_mth,"prec2h2",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
-c
+       call histwrite_phy(nid_mth,.false.,"prec2h2",
+     .            itau_w,precip(1:klon,3))
 c       -----  NOY
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,4),zx_tmp_2d)
-       CALL histwrite(nid_mth,"prenoy",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_mth,.false.,"prenoy",
+     .            itau_w,precip(1:klon,4))
 c       -----  AER
-       CALL gr_fi_ecrit(1, klon,iim,jjmp1,precip(1:klon,5),zx_tmp_2d)
-       CALL histwrite(nid_mth,"preaer",itau_w,zx_tmp_2d,
-     .                        iim*jjmp1,ndex2d)
+       call histwrite_phy(nid_mth,.false.,"preaer",
+     .            itau_w,precip(1:klon,5))
 c --------------
 c ----- FLUX GLACE
 c       -----  CH4
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .                  flxesp_i(1:klon,1:klev,1),zx_tmp_3d)
-       CALL histwrite(nid_mth,"flxgl1", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,"flxgl1",
+     .            itau_w,flxesp_i(1:klon,1:klev,1))
 c       -----  C2H6
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .                  flxesp_i(1:klon,1:klev,2),zx_tmp_3d)
-       CALL histwrite(nid_mth,"flxgl2", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,"flxgl2",
+     .            itau_w,flxesp_i(1:klon,1:klev,2))
 c       -----  C2H2
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .                  flxesp_i(1:klon,1:klev,3),zx_tmp_3d)
-       CALL histwrite(nid_mth,"flxgl3", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,"flxgl3",
+     .            itau_w,flxesp_i(1:klon,1:klev,3))
 c --------------
 c ----- Source/puits GLACE
 c       -----  CH4
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .                          solesp(1:klon,1:klev,1),zx_tmp_3d)
-       CALL histwrite(nid_mth,"solch4", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,"solch4",
+     .            itau_w,solesp(1:klon,1:klev,1))
 c       -----  C2H6
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .                          solesp(1:klon,1:klev,2),zx_tmp_3d)
-       CALL histwrite(nid_mth,"solc2h6", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,"solc2h6",
+     .            itau_w,solesp(1:klon,1:klev,2))
 c       -----  C2H2
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,
-     .                          solesp(1:klon,1:klev,3),zx_tmp_3d)
-       CALL histwrite(nid_mth,"solc2h2", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+       call histwrite_phy(nid_mth,.false.,"solc2h2",
+     .            itau_w,solesp(1:klon,1:klev,3))
 c --------------
 c ----- RAYON MOYEN GOUTTE
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, rmcloud,zx_tmp_3d)
-       CALL histwrite(nid_mth,"rcldbar", itau_w, zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+       call histwrite_phy(nid_mth,.false.,"rcldbar",itau_w,rmcloud)
+
              endif
 	  endif
-c
+
 c --------------
 c ----- TRACEURS CHIMIQUES
           if (nmicro.lt.nqmax) then
            DO iq=nmicro+1,nqmax
-       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
-       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+       call histwrite_phy(nid_mth,.false.,tname(iq),
+     .                    itau_w,tr_seri(1:klon,1:klev,iq))
            ENDDO
 c Condensation:
 c          DO iq=nmicro+1,nqmax
-c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
-c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
+c      call histwrite_phy(nid_mth,.false.,"c_"//tname(iq),
+c    .                    itau_w,d_tr_mph(1:klon,1:klev,iq))
 c          ENDDO
 	  endif
          endif
-c
+
       ENDIF !lev_histmth.GE.2
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.3) THEN
-c
+
 cccccccccccccccccc  Radiative transfer
-c
+
 c 2D
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
-      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+      call histwrite_phy(nid_mth,.false.,"topl",itau_w,toplw)
+      call histwrite_phy(nid_mth,.false.,"sols",itau_w,solsw)
+      call histwrite_phy(nid_mth,.false.,"soll",itau_w,sollw)
+
 c 3D
-c
-      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+
+      call histwrite_phy(nid_mth,.false.,"SWnet",
+     .          itau_w,swnet(1:klon,1:klev))
+      call histwrite_phy(nid_mth,.false.,"LWnet",
+     .          itau_w,lwnet(1:klon,1:klev))
+
 c --------------
 c ----- OPACITE BRUME
@@ -301,9 +199,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"thv"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECV 
 
@@ -314,11 +209,7 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"thi"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECI 
-c
 c --------------
 c ----- EXTINCTION BRUME
@@ -335,9 +226,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"khv"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECV 
 
@@ -354,11 +242,7 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"khi"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECI 
-c
 c --------------
 c ----- OPACITE GAZ
@@ -369,9 +253,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"tgv"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECV 
 
@@ -382,11 +263,7 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"tgi"//str2,itau_w,t_tauhvd)
        enddo      ! fin boucle NSPECI 
-c
 c --------------
 c ----- EXTINCTION GAZ
@@ -403,9 +280,6 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"kgv"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECV 
 
@@ -423,18 +297,13 @@
          enddo
          enddo
-         write(str1,'(i2.2)') k
-      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         write(str2,'(i2.2)') k
+       call histwrite_phy(nid_mth,.false.,"kgi"//str2,itau_w,t_khvd)
        enddo      ! fin boucle NSPECI 
 
 c --------------
+         if (clouds.eq.1) then
+c --------------
 c ----- OPACITE NUAGES (ATTENTION PROXY)
-         if (clouds.eq.1) then
-           zx_tmp_fi3d(1:klon,1:klev)=occcld(1:klon,1:klev)
-           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-           CALL histwrite(nid_mth,"tcld",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+         call histwrite_phy(nid_mth,.false.,"tcld",itau_w,occcld)
 c --------------
 c ----- EXTINCTION NUAGES (ATTENTION PROXY)
@@ -447,97 +316,48 @@
              enddo
            enddo
-           zx_tmp_fi3d(1:klon,1:klev)=t_kcld(1:klon,1:klev)
-           CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-           CALL histwrite(nid_mth,"kcld",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+         call histwrite_phy(nid_mth,.false.,"kcld",itau_w,t_kcld)
 c --------------
 c ----- OCCURENCE NUAGES
            do k=1,12
-             write(str1,'(i2.2)') k
-             zx_tmp_fi3d(1:klon,1:klev)=occcld_m(1:klon,1:klev,k)
-             CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-             CALL histwrite(nid_mth,"occcld"//str1,itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+             write(str2,'(i2.2)') k
+        call histwrite_phy(nid_mth,.false.,"occcld"//str2,
+     .          itau_w,occcld_m(1:klon,1:klev,k))
            enddo
-c
+c --------------
         endif  
-c
+c --------------
+
       ENDIF !lev_histmth.GE.3
-c
+
 c-------------------------------------------------------
       IF(lev_histmth.GE.4) THEN
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
+
+      call histwrite_phy(nid_mth,.false.,"dtdyn",itau_w,d_t_dyn)
+      call histwrite_phy(nid_mth,.false.,"dtphy",itau_w,d_t)
 c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+      call histwrite_phy(nid_mth,.false.,"dtvdf",itau_w,d_t_vdf)
 c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+      call histwrite_phy(nid_mth,.false.,"dtajs",itau_w,d_t_ajs)
 c K/s
-      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
+      call histwrite_phy(nid_mth,.false.,"dtswr",itau_w,heat)
+c K/s
+      call histwrite_phy(nid_mth,.false.,"dtlwr",itau_w,-1.*cool)
 c K/s      
-      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c K/s      
-c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
-c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
-      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
-      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
-     .                                   iim*jjmp1*klev,ndex3d)
-c
-c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
-c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
-c    .                                   iim*jjmp1*klev,ndex3d)
-c
+c      call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec)
+c      call histwrite_phy(nid_mth,.false.,"dvvdf",itau_w,d_v_vdf)
+
       ENDIF !lev_histmth.GE.4
 c
 c-------------------------------------------------------
       IF(lev_histmth.GE.5) THEN
-c
-c
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
-c      CALL histwrite(nid_mth,"taux_",itau_w,
-c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
-c      
-c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
-c      CALL histwrite(nid_mth,"tauy_",itau_w,
-c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
-c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
-c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
-c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
-c
+
+c      call histwrite_phy(nid_mth,.false.,"taux",itau_w,fluxu)
+c      call histwrite_phy(nid_mth,.false.,"tauy",itau_w,fluxv)
+c      call histwrite_phy(nid_mth,.false.,"cdrm",itau_w,cdragm)
+c      call histwrite_phy(nid_mth,.false.,"cdrh",itau_w,cdragh)
+
       ENDIF !lev_histmth.GE.5
 c-------------------------------------------------------
-c
+
       if (ok_sync) then
         call histsync(nid_mth)
Index: trunk/LMDZ.TITAN/libf/phytitan/writeg1d.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/writeg1d.F	(revision 1055)
+++ 	(revision )
@@ -1,239 +1,0 @@
-      SUBROUTINE writeg1d(ngrid,nx,x,nom,titre)
-      IMPLICIT NONE
-c.......................................................................
-c
-c  ecriture de x pour GRADS-1D
-c
-c  in :
-c         * ngrid      ---> pour controler que l'on est bien en 1D
-c         * nx         ---> taille du vecteur a stocker
-c                             "1" pour une variable de surface
-c                             "nlayer" pour une variable de centre de couche
-c                             "nlayer+1" pour une variable d'interface
-c         * x          ---> variable a stocker
-c         * nom        ---> nom "pour grads"
-c         * titre      ---> titre "pour grads"
-c
-c.......................................................................
-c
-#include "comg1d.h"
-
-c
-c.......................................................................
-c  declaration des arguments 
-c
-      INTEGER ngrid,nx,i
-      REAL*4 xr4(1000)
-      REAL x(nx)
-      CHARACTER*(*) nom,titre
-c
-c  declaration des arguments 
-c....................................................................... 
-c  declaration des variables locales
-c
-      INTEGER ilayer,ivar
-      LOGICAL test 
-
-
-      integer isortie  ! les sorties ne se font qu'une fois tous les
-      logical oksortie ! nbphypers appels de la physique
-      save    isortie
-c
-c  declaration des variables locales
-c.......................................................................
-c  controle 1D
-c
-c     print*,'ngrid=',ngrid
-      IF (ngrid.NE.1) return
-c
-c  controle 1D
-c.......................................................................
-c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
-
-      do i=1,nx
-        xr4(i) = x(i)
-      enddo
-
-c  copy => force en reel 4 pour l'ecriture dans grads1d.dat
-c.......................................................................
-c  ouverture du fichier au premier appel
-c
-      IF (g1d_premier) THEN
-        OPEN (g1d_unitfich,FILE=g1d_nomfich
-     &       ,FORM='unformatted',ACCESS='direct',RECL=4)
-        g1d_irec=0
-        g1d_nvar=0
-        
-        oksortie= .true.
-        isortie = nbphypers
-      ENDIF
-c
-c  ouverture du fichier au premier appel
-c.......................................................................
-c  rythme des sorties
-      if (.not.g1d_premier) then
-        oksortie=.false.
-        if (nom.eq.g1d_nomvar(1)) then
-          if (isortie.eq.nbphypers) then
-            isortie = 1
-          else 
-            if (isortie.eq.(nbphypers-1)) then
-              oksortie=.true.
-              isortie = nbphypers
-            else
-              isortie = isortie+1
-            endif
-          endif
-        else
-          if (isortie.eq.nbphypers) then
-            oksortie=.true.
-          endif
-        endif
-      endif
-c  rythme des sorties
-c.......................................................................
-c  pour l'ecriture du fichier ctl
-c
-      test=.true.
-      DO ivar=1,g1d_nvar
-        IF (nom.EQ.g1d_nomvar(ivar)) test=.false.
-        IF (nx .GT. 1000) then
-          print*,'ERROR:  nx > 1000 dans writeg1d.F' 
-          print*,'Changer la dimension de xr4'
-          call exit(1)
-        ENDIF
-      ENDDO
-      IF (test) THEN
-        g1d_nvar=g1d_nvar+1
-        g1d_nomvar(g1d_nvar)=nom
-        g1d_titrevar(g1d_nvar)=titre
-        IF (nx.EQ.1) THEN
-           g1d_dimvar(g1d_nvar)=0
-        ELSEIF (nx.EQ.g1d_nlayer) THEN
-           g1d_dimvar(g1d_nvar)=g1d_nlayer
-        ELSEIF (nx.EQ.g1d_nlayer+1) THEN
-           g1d_dimvar(g1d_nvar)=g1d_nlayer+1
-        ELSE
-           PRINT *,'._. probleme de dimension dans GRADS-1D ._.'
-           print*,'NX = ',nx
-           print*,'g1d_nlayer = ',g1d_nlayer
-        ENDIF
-      ENDIF
-c
-c  pour l'ecriture du fichier ctl
-c.......................................................................
-c  test pour rythme des sorties
-      if (oksortie) then
-c             print*,nom,isortie,' ok'
-c.......................................................................
-c  ecriture
-c
-      IF (nx.EQ.1) THEN
-        g1d_irec=g1d_irec+1
-        WRITE(g1d_unitfich,REC=g1d_irec) xr4(1)
-      ELSE
-        DO ilayer=1,g1d_nlayer
-          g1d_irec=g1d_irec+1
-          WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer)
-        ENDDO
-      ENDIF
-c
-c  ecriture
-c.......................................................................
-c     else
-c             print*,nom,isortie
-      endif
-c  test pour rythme des sorties
-c.......................................................................
-c
-        g1d_premier=.false.
-      RETURN
-      END
-
-
-
-
-
-c *********************************************************************
-c *********************************************************************
-
-      SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt)
-      IMPLICIT NONE
-c.......................................................................
-c
-c  ecriture du fichier de controle pour GRADS-1D
-c
-c  in :
-c         * ngrid      ---> pour controler que l'on est bien en 1D
-c         * nlayer     ---> nombre de couches
-c         * zlayer     ---> altitude au centre de chaque couche (km)
-c         * ndt        ---> nombre de pas de temps
-c
-c.......................................................................
-c
-#include "comg1d.h"
-#include "comcstfi.h"
-c
-c.......................................................................
-c  declaration des arguments 
-c
-      INTEGER ngrid,nlayer
-      REAL zlayer(nlayer)
-      INTEGER ndt
-c
-c  declaration des arguments 
-c....................................................................... 
-c  declaration des variables locales
-c
-      INTEGER ivar,ilayer
-c
-c  declaration des variables locales
-c.......................................................................
-c  contole 1D
-c
-      IF (ngrid.NE.1) GOTO 10001
-c
-c  contole 1D
-c.......................................................................
-c
-      IF (nlayer.ne.g1d_nlayer) 
-     &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) '
-c
-c.......................................................................
-c
-      CLOSE (g1d_unitfich)
-c
-c.......................................................................
-c
-      OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100)
-      WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich
-      WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30'
-      WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV'
-      WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D'
-      WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1'
-      WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1'
-      WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS'
-      WRITE (g1d_unitctl,'(5(1x,f13.5))')
-     &      (zlayer(ilayer),ilayer=1,g1d_nlayer)
-
-c     Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24)
-      ivar =min( max(int(1440.*dtphys*nbphypers/daysec +0.5),1) , 99)   
-      WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)')
-     &      'TDEF ',ndt/nbphypers,' LINEAR 01JAN2000 ', ivar,'MN '
-
-      WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar
-      DO ivar=1,g1d_nvar
-      WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') 
-     &       g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar)
-      ENDDO
-      WRITE (g1d_unitctl,'(a7)') 'ENDVARS'
-      CLOSE (g1d_unitctl)
-c
-c.......................................................................
-c
-10001 CONTINUE
-c
-c.......................................................................
-c
-      RETURN
-      END
Index: trunk/LMDZ.TITAN/libf/phytitan/writerestart.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/writerestart.F	(revision 1056)
+++ trunk/LMDZ.TITAN/libf/phytitan/writerestart.F	(revision 1056)
@@ -0,0 +1,495 @@
+      SUBROUTINE writerestart(fichnom,tab_cntrl,
+     .                  phis,vcov,ucov,teta,masse,q,ps)
+
+      USE IOIPSL
+      USE infotrac
+
+      IMPLICIT NONE
+
+c=======================================================================
+c Ecriture du fichier de redemarrage sous format NetCDF (pour newstart)
+c=======================================================================
+c   Declarations:
+c   -------------
+#include "dimensions.h"
+#include "paramet.h"
+#include "comconst.h"
+#include "comvert.h"
+#include "comgeom.h"
+#include "ener.h"
+#include "logic.h"
+#include "netcdf.inc"
+#include "description.h"
+#include "serre.h"
+
+c   Arguments:
+c   ----------
+      CHARACTER*(*) fichnom
+      INTEGER length
+      PARAMETER (length = 100)
+      REAL tab_cntrl(length) ! tableau des parametres du run
+      REAL phis(ip1jmp1)
+      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
+      REAL teta(ip1jmp1,llm),q(ip1jmp1,llm,nqtot) 
+      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
+
+c   Local:
+c   ------
+      INTEGER iq,l
+      INTEGER ierr
+      character*20 modname
+      character*80 abort_message
+
+c   Variables locales pour NetCDF:
+c
+      INTEGER dims2(2), dims3(3), dims4(4)
+      INTEGER idim_index
+      INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
+      INTEGER idim_s, idim_sig
+      INTEGER idim_tim
+      INTEGER nid,nvarid
+
+      character*30 unites
+
+
+c-----------------------------------------------------------------------
+c Creation du fichier:
+c-----------------------------------------------------------------------
+c
+      modname='write_restart_ini'
+
+      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
+      IF (ierr.NE.NF_NOERR) THEN
+         WRITE(6,*)" Pb d ouverture du fichier "//fichnom
+         WRITE(6,*)' ierr = ', ierr
+         CALL ABORT
+      ENDIF
+c
+c Preciser quelques attributs globaux:
+c
+      ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
+     .                       "Fichier demarrage dynamique")
+c
+c Definir les dimensions du fichiers:
+c
+      ierr = NF_DEF_DIM (nid, "index", length, idim_index)
+      ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
+      ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
+      ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
+      ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
+      ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
+      ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
+      ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+c
+c Definir et enregistrer certains champs invariants:
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Parametres de controle")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
+     .                       "Longitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Latitudes des points V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
+     .                       "Numero naturel des couches s")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
+     .                       "Numero naturel des couches sigma")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
+     .                       "Coefficient A pour hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
+     .                       "Coefficient B pour hybride")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
+#endif
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
+#endif
+c
+c Coefficients de passage cov. <-> contra. <--> naturel
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonu
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour U")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
+#endif
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatv
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
+     .                       "Coefficient de passage pour V")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
+#endif
+c
+c Aire de chaque maille:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
+     .                       "Aires de chaque maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
+#endif
+c
+c Geopentiel au sol:
+c
+      ierr = NF_REDEF (nid)
+      dims2(1) = idim_rlonv
+      dims2(2) = idim_rlatu
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Geopotentiel au sol")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,phis)
+#endif
+c
+c Definir les variables pour pouvoir les enregistrer plus tard:
+c
+      ierr = NF_REDEF (nid) ! entrer dans le mode de definition
+c
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
+     .                       "Temps de simulation")
+      write(unites,200) 1990,1,1
+200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
+     .                         unites)
+
+c
+      dims4(1) = idim_rlonu
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Vitesse U")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatv
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
+     .                       "Vitesse V")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
+     .                       "Temperature")
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+      DO iq=1,nqtot
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
+      ENDDO
+c
+      dims4(1) = idim_rlonv
+      dims4(2) = idim_rlatu
+      dims4(3) = idim_s
+      dims4(4) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
+     .                       "C est quoi ?")
+c
+      dims3(1) = idim_rlonv
+      dims3(2) = idim_rlatu
+      dims3(3) = idim_tim
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
+     .                       "Pression au sol")
+c
+      ierr = NF_ENDDEF(nid) ! sortir du mode de definition
+
+c-----------------------------------------------------------------------
+c Ecriture des variables:
+c-----------------------------------------------------------------------
+c
+      modname='write_restart'
+
+      ierr = NF_INQ_VARID(nid, "temps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         print *, NF_STRERROR(ierr)
+         abort_message='Variable temps n est pas definie'
+         CALL abort_gcm(modname,abort_message,ierr)
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,1,0.)
+#else
+      ierr = NF_PUT_VAR1_REAL (nid,nvarid,1,0.)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "ucov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable ucov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "vcov", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable vcov n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov)
+#endif
+
+      ierr = NF_INQ_VARID(nid, "teta", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable teta n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,teta)
+#endif
+
+       do iq=1,nqtot   
+        ierr = NF_INQ_VARID(nid, tname(iq), nvarid)
+        IF (ierr .NE. NF_NOERR) THEN
+           PRINT*, "Variable  tname(iq) n est pas definie"
+           CALL abort
+        ENDIF
+#ifdef NC_DOUBLE
+          ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))
+#else
+          ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))
+#endif
+      ENDDO
+c
+      ierr = NF_INQ_VARID(nid, "masse", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable masse n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,masse)
+#endif
+c
+      ierr = NF_INQ_VARID(nid, "ps", nvarid)
+      IF (ierr .NE. NF_NOERR) THEN
+         PRINT*, "Variable ps n est pas definie"
+         CALL abort
+      ENDIF
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,ps)
+#endif
+
+      ierr = NF_CLOSE(nid) ! fermer le fichier
+
+c      PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
+c      PRINT*,'rad,omeg,g,cpp,kappa',
+c     ,        rad,omeg,g,cpp,kappa
+
+      RETURN
+      END
+
Index: trunk/LMDZ.TITAN/libf/phytitan/writerestartphy.F
===================================================================
--- trunk/LMDZ.TITAN/libf/phytitan/writerestartphy.F	(revision 1055)
+++ trunk/LMDZ.TITAN/libf/phytitan/writerestartphy.F	(revision 1056)
@@ -4,4 +4,5 @@
      .           solsw, sollw,fder,
      .           radsol,
+     .    zmea, zstd, zsig, zgam, zthe, zpic, zval,
      .           t_ancien)
 
@@ -27,4 +28,7 @@
       real fder(klon)
       REAL radsol(klon)
+      REAL zmea(klon), zstd(klon)
+      REAL zsig(klon), zgam(klon), zthe(klon)
+      REAL zpic(klon), zval(klon)
       REAL t_ancien(klon,klev)
 c
@@ -218,4 +222,109 @@
       ierr = NF_REDEF (nid)
 #ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZMEA", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zmea Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zmea)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zmea)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSTD", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zstd Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zstd)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zstd)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZSIG", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zsig Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zsig)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zsig)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZGAM", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zgam Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zgam)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zgam)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZTHE", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zthe Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zthe)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zthe)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZPIC", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZPIC", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zpic Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zpic)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zpic)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
+      ierr = NF_DEF_VAR (nid, "ZVAL", NF_DOUBLE, 1, idim2,nvarid)
+#else
+      ierr = NF_DEF_VAR (nid, "ZVAL", NF_FLOAT, 1, idim2,nvarid)
+#endif
+      ierr = NF_PUT_ATT_TEXT (nid,nvarid,"title", 28,
+     .                        "zval Orographie sous-maille")
+      ierr = NF_ENDDEF(nid)
+#ifdef NC_DOUBLE
+      ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,zval)
+#else
+      ierr = NF_PUT_VAR_REAL (nid,nvarid,zval)
+#endif
+c
+      ierr = NF_REDEF (nid)
+#ifdef NC_DOUBLE
       ierr = NF_DEF_VAR (nid, "TANCIEN", NF_DOUBLE, 1, idim3,nvarid)
 #else
